新型SysTray提示

在Windows2000里面，拨号网络连接之后，或者是收藏夹被折叠的时候，会有一个漫画框式的提示，这个需要IE5以上的支持。

procedure TForm1.AddNewSysTrayIcon;

const

 TRAY_CALLBACK = WM_USER + $7258;

 NIF_INFO = $10;

 NIM_SETVERSION = $00000004;

 NOTIFYICON_VERSION = 3;

 NIM_SETFOCUS = $00000003;

 NIIF_INFO = $00000001;

 NIN_BALLOONSHOW = WM_USER + 2;

 NIN_BALLOONHIDE = WM_USER + 3;

 NIN_BALLOONTIMEOUT = WM_USER + 4;

 NIN_BALLOONUSERCLICK = WM_USER + 5;

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;

   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;

var

 TipInfo, TipTitle: string;

 IconData: TNewNotifyIconData;

begin

 IconData.cbSize := sizeof(IconData);

 IconData.Wnd := Handle;

 IconData.uID := 0;

 IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_INFO or NIF_TIP;

 IconData.uCallbackMessage := TRAY_CALLBACK;

 IconData.hIcon := Image1.Picture.Icon.Handle;  ///an icon's handle

 IconData.szTip := 'That''s all.';

 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;

 if not Shell_NotifyIcon(NIM_ADD, @IconData) then

   showmessage('add fail');

 IconData.DUMMYUNIONNAME.uVersion := NOTIFYICON_VERSION;

 if not Shell_NotifyIcon(NIM_SETVERSION, @IconData) then

   showmessage('setversion fail');

end;

**************

首先定义新的常数：

const

 NIF_INFO = $10;

 NIM_SETVERSION = $00000004;

 NOTIFYICON_VERSION = 3;

 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;

 {上面列的可能不全，如果没有定义到的，可在 vs.net 中 vc7 中的 PlatformSDK\Include\ShellAPI.h 中找到}

再定义一个SysTrayIcon的回传消息：

 TRAY_CALLBACK = WM_USER + $7258;

然后定义新的 NotifyIconData 结构（放在Type中）：

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;

   szTip: array [0..127] of Char;    //Version 5.0为128个，以前为64个

   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;

声明一个全局变量：

var

 IconData: TNewNotifyIconData;

接着转入正题，下面一个过程用来添加 SystrayIcon ：

procedure AddSysTrayIcon;

begin

 IconData.cbSize := sizeof(IconData);

 IconData.Wnd := AllocateHWnd(SysTrayIconMsgHandler);    //Self.Handle;  {SysTrayIconMsgHandler 为后面定义的消息处理过程}

 IconData.uID := 0;

 IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;

 IconData.uCallbackMessage := TRAY_CALLBACK;   //自定义回传消息

 IconData.hIcon := Image1.Picture.Icon.Handle;    //此处为一 Icon 的 Handle

 IconData.szTip := 'Please send me email.';

 if not Shell_NotifyIcon(NIM_ADD, @IconData) then

   showmessage('add fail');

end;

再有一个过程用来显示 Balloon Tips ：

procedure 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);

 //下面的代码实际上没有用，去掉也可以（至少目前这样认为）

 IconData.DUMMYUNIONNAME.uVersion := NOTIFYICON_VERSION;

 if not Shell_NotifyIcon(NIM_SETVERSION, @IconData) then

   showmessage('setversion fail');

end;

别忘了删除过程：

procedure DeleteSysTrayIcon;

begin

 DeallocateHWnd(IconData.Wnd);

 if not Shell_NotifyIcon(NIM_DELETE, @IconData) then

   showmessage('delete fail');

end;

还有重要的环节---消息处理：

声明：

 procedure SysTrayIconMsgHandler(var Msg: TMessage); message TRAY_CALLBACK;

定义：

procedure SysTrayIconMsgHandler(var Msg: TMessage);

begin

 case Msg.LParam of

   WM_MOUSEMOVE: ;

   WM_LBUTTONDOWN: ;

   WM_LBUTTONUP: ;

   WM_LBUTTONDBLCLK: ;

   WM_RBUTTONDOWN: ;

   WM_RBUTTONUP: ;

   WM_RBUTTONDBLCLK: ;

   //以下为新加入的消息

   NIN_BALLOONSHOW:     {当 Balloon Tips 弹出时执行}

     showmessage('NIN_BALLOONSHOW');

   NIN_BALLOONHIDE:    {当 Balloon Tips 消失时执行（例如 SysTrayIcon 被删除），但指定的 TimeOut 时间到或鼠标点击 Balloon Tips 后的消失不发送此消息}

     showmessage('NIN_BALLOONHIDE');  

   NIN_BALLOONTIMEOUT:        {当 Balloon Tips 的 TimeOut 时间到时执行}

     showmessage('NIN_BALLOONTIMEOUT');

   NIN_BALLOONUSERCLICK:    {当鼠标点击 Balloon Tips 时执行。注意：在XP下执行时 Balloon Tips 上有个关闭按钮，而且 Balloon Tips 一直显示（IconData.DUMMYUNIONNAME.uTimeout := 3000; 这句话设定的时间没有用，我的测试是这样的），如果鼠标点在按钮上将接收到 NIN_BALLOONTIMEOUT 消息。}

     showmessage('NIN_BALLOONUSERCLICK');

 end;

end;

好了，代码写完了。我原先还在到处贴贴子问及如何强制显示 SysTrayIcon 的Tips，现在看来只要执行 ShowBalloonTips （将结构中新的域赋上值，执行NIM_MODIFY 动作）就立即显示出来了。不知道自己回答了自己的问题斑竹会不会给分啊。 ^_^

新特性需要 IE5.0 或以上版本，我在 Win2000、XP + Delphi 6.0下测试通过。手头没有98/ME，不知道可不可以。

（完）