반응형
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.
반응형
'Programming > Delphi' 카테고리의 다른 글
문자열 파싱하기 (0) | 2010.06.30 |
---|---|
델파이에서 아이폰 개발이 가능해진다? (0) | 2010.06.30 |
윈도우 각종 폴더 경로 얻기 (0) | 2010.06.30 |
파일 사이즈(int64) -> 문자로 표시 (0) | 2010.06.30 |
DHTML 컴포넌트 생성하는 방법 (0) | 2010.06.30 |