发新话题
打印

[语言基础/算法] 支持XP下托盘栏气球提示的托盘单元

支持XP下托盘栏气球提示的托盘单元

复制内容到剪贴板
代码:
unit tray;
{//使用简介:IconOnClick
//先添加常量, InstIcon(Application.Icon, Handle,WM_ICONEVENT);这里要用到的
WM_ICONEVENT=WM_USER+111;
//申明部分
procedure IconOnClick(var message:TMessage);message WM_ICONEVENT;
//实现部分
procedure TForm1.IconOnClick(var message:Tmessage);
var
p:Tpoint;
begin
if (message.LParam=WM_LBUTTONDBLCLK) then
begin
   //双击左键
end;
if (message.LParam=WM_RBUTTONDOWN) then
begin
   GetCursorPos(p);
   PopupMenu1.Popup(p.X,p.Y);
end;
end;                          }

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,Registry,ShellAPI, ComCtrls, StdCtrls, Buttons, Menus, ExtCtrls;

const
ICON_ID=3;
NIF_INFO = ;
NIM_SETVERSION = {post.content}000004;
NOTIFYICON_VERSION = 3;
NIM_SETFOCUS = {post.content}000003;
NIIF_INFO = {post.content}000001;
NIIF_WARNING = {post.content}000002;
NIIF_ERROR = {post.content}000003;
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 = ;
NIN_KEYSELECT = NIN_SELECT or NINF_KEY;

procedure InstIcon(ToyIcon:TIcon;WinHandle:THandle;cbMessage:Integer);
procedure DeleIcon(winHandle:THandle);
procedure ShowBalloonTips(TipInfo,TipTitle:string);


implementation

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;

procedure InstIcon(ToyIcon:TIcon;WinHandle:THandle;cbMessage:Integer);
begin
IconData.cbSize:=Sizeof(IconData);
IconData.Wnd:=WinHandle;
IconData.uID:=ICON_ID;
IconData.uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
IconData.uCallbackMessage:=cbMessage;
IconData.hIcon:=ToyIcon.Handle;
IconData.szTip:='LavaTech--Enhance the life!';       //使用是该修改
Shell_NotifyIcon(NIM_ADD,@IconData);
end;

procedure DeleIcon(winHandle:THandle);
begin
IconData.cbSize:=SizeOf(IconData);
IconData.Wnd:=winHandle;
IconData.uID:=ICON_ID;
Shell_NotifyIcon(NIM_DELETE,@IconData);
end;

procedure ShowBalloonTips(TipInfo,TipTitle:string);
begin
IconData.cbSize := sizeof(IconData);
IconData.uFlags := NIF_INFO;
strPLCopy(IconData.szInfo, TipInfo, sizeof(IconData.szInfo) - 1);
IconData.DUMMYUNIONNAME.uTimeout := 3000;
strPLCopy(IconData.szInfoTitle, TipTitle, sizeof(IconData.szInfoTitle) - 1);
IconData.dwInfoFlags := NIIF_INFO;
Shell_NotifyIcon(NIM_MODIFY, @IconData);
end;

end.
以上代码复制到记事本保存为 Tray.pas 文件即可直接使用。使用方法:在你的程序代码的 uses 段加入Tray即可。
妖城欢迎您!

TOP

发新话题