Programming/Delphi

트레이 풍선 도움말

통통만두 2010. 6. 30. 15:23
반응형

interface 

uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; 

{new constant definitions} 

const 
  NIF_INFO = $10; 
  NIF_MESSAGE = 1; 
  NIF_ICON = 2; 
  NOTIFYICON_VERSION = 3; 
  NIF_TIP = 4; 
  NIM_SETVERSION = $00000004; 
  NIM_SETFOCUS = $00000003; 
  NIIF_INFO = $00000001; 
  NIIF_WARNING = $00000002; 
  NIIF_ERROR = $00000003; 

  NIN_BALLOONSHOW = WM_USER + 2; 
  NIN_BALLOONHIDE = WM_USER + 3; 
  NIN_BALLOONTIMEOUT = WM_USER + 4; 
  NIN_BALLOONUSERCLICK = WM_USER + 5; 
  NIN_SELECT = WM_USER + 0; 
  NINF_KEY = $1; 
  NIN_KEYSELECT = NIN_SELECT or NINF_KEY; 
   
  NIN_BALLOONSHOW = WM_USER + 2; 
  NIN_BALLOONHIDE = WM_USER + 3; 
  NIN_BALLOONTIMEOUT = WM_USER + 4; 
  NIN_BALLOONUSERCLICK = WM_USER + 5; 
  NIN_SELECT = WM_USER + 0; 
  NINF_KEY = $1; 
  NIN_KEYSELECT = NIN_SELECT or NINF_KEY; 
  {other constants can be found in vs.net---vc7's dir: PlatformSDKIncludeShellAPI.h} 

  {define the callback message} 
  TRAY_CALLBACK = WM_USER + $7258; 

  {new NotifyIconData structure definition} 
type 
  PNewNotifyIconData = ^TNewNotifyIconData; 
  TDUMMYUNIONNAME    = record 
    case Integer of 
      0: (uTimeout: UINT); 
      1: (uVersion: UINT); 
  end; 

  TNewNotifyIconData = record 
    cbSize: DWORD; 
    Wnd: HWND; 
    uID: UINT; 
    uFlags: UINT; 
    uCallbackMessage: UINT; 
    hIcon: HICON; 
   //Version 5.0 is 128 chars, old ver is 64 chars 
    szTip: array [0..127] of Char; 
    dwState: DWORD; //Version 5.0 
    dwStateMask: DWORD; //Version 5.0 
    szInfo: array [0..255] of Char; //Version 5.0 
    DUMMYUNIONNAME: TDUMMYUNIONNAME; 
    szInfoTitle: array [0..63] of Char; //Version 5.0 
    dwInfoFlags: DWORD;   //Version 5.0 
  end; 


type 
  TForm1 = class(TForm) 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  private 
    IconData: TNewNotifyIconData; 
    procedure SysTrayIconMsgHandler(var Msg: TMessage); message TRAY_CALLBACK; 
    procedure AddSysTrayIcon; 
    procedure ShowBalloonTips; 
    procedure DeleteSysTrayIcon; 
  public 
  end; 

var 
  Form1: TForm1; 

implementation 

{$R *.DFM} 

uses 
  ShellAPI; 

procedure TForm1.SysTrayIconMsgHandler(var Msg: TMessage); 
begin 
  case Msg.lParam of 
    WM_MOUSEMOVE:; 
    WM_LBUTTONDOWN:; 
    WM_LBUTTONUP:; 
    WM_LBUTTONDBLCLK:; 
    WM_RBUTTONDOWN:; 
    WM_RBUTTONUP:; 
    WM_RBUTTONDBLCLK:; 
    //followed by the new messages 
    NIN_BALLOONSHOW: 
    {Sent when the balloon is shown} 
      ShowMessage('NIN_BALLOONSHOW'); 
    NIN_BALLOONHIDE: 
    {Sent when the balloon disappears?Rwhen the icon is deleted, 
    for example. This message is not sent if the balloon is dismissed because of 
    a timeout or mouse click by the user. } 
      ShowMessage('NIN_BALLOONHIDE'); 
    NIN_BALLOONTIMEOUT: 
    {Sent when the balloon is dismissed because of a timeout.} 
      ShowMessage('NIN_BALLOONTIMEOUT'); 
    NIN_BALLOONUSERCLICK: 
    {Sent when the balloon is dismissed because the user clicked the mouse. 
    Note: in XP there's Close button on he balloon tips, when click the button, 
    send NIN_BALLOONTIMEOUT message actually.} 
      ShowMessage('NIN_BALLOONUSERCLICK'); 
  end; 
end; 

  {AddSysTrayIcon procedure add an icon to notification area} 
procedure TForm1.AddSysTrayIcon; 
begin 
  IconData.cbSize := SizeOf(IconData); 
  IconData.Wnd := AllocateHWnd(SysTrayIconMsgHandler); 
  {SysTrayIconMsgHandler is then callback message' handler} 
  IconData.uID := 0; 
  IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP; 
  IconData.uCallbackMessage := TRAY_CALLBACK;   //user defined callback message 
  IconData.hIcon := Application.Icon.Handle;    //an Icon's Handle 
  IconData.szTip := 'Please send me email.'; 
  if not Shell_NotifyIcon(NIM_ADD, @IconData) then 
    ShowMessage('add fail'); 
end; 

{ShowBalloonTips procedure carry out the new feature: Balloon Tips} 
procedure TForm1.ShowBalloonTips; 
var 
  TipInfo, TipTitle: string; 
begin 
  IconData.cbSize := SizeOf(IconData); 
  IconData.uFlags := NIF_INFO; 
  TipInfo := 'Please send me email.'; 
  strPLCopy(IconData.szInfo, TipInfo, SizeOf(IconData.szInfo) - 1); 
  IconData.DUMMYUNIONNAME.uTimeout := 3000; 
  TipTitle := 'Happyjoe@21cn.com'; 
  strPLCopy(IconData.szInfoTitle, TipTitle, SizeOf(IconData.szInfoTitle) - 1); 
  IconData.dwInfoFlags := NIIF_INFO;     //NIIF_ERROR;  //NIIF_WARNING; 
  Shell_NotifyIcon(NIM_MODIFY, @IconData); 
  {in my testing, the following code has no use} 
  IconData.DUMMYUNIONNAME.uVersion := NOTIFYICON_VERSION; 
  if not Shell_NotifyIcon(NIM_SETVERSION, @IconData) then 
    ShowMessage('setversion fail'); 
end; 

{here's the deletion procedure} 
procedure TForm1.DeleteSysTrayIcon; 
begin 
  DeallocateHWnd(IconData.Wnd); 
  if not Shell_NotifyIcon(NIM_DELETE, @IconData) then 
    ShowMessage('delete fail'); 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  AddSysTrayIcon; 
  ShowBalloonTips; 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  DeleteSysTrayIcon; 
end; 

end.  


반응형