procedure Icon_ADD (hdlg:integer;strin:String;iconname:TIcon);
begin
if not Isexisted then
try
new (ptnd);
ptnd.cbsize:=sizeof(TNOTIFYICONDATAA);
strPcopy(ptnd.szTip,strin);
ptnd.uCallbackMessage:=MYWM_NOTIFYICON;
ptnd.uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
Ptnd.uID:=IDC_NOTIFY;
Ptnd.hIcon:=iconname.Handle;
Ptnd.Wnd:=hdlg;
Shell_notifyIcona(NIM_ADD,ptnd);
dispose(ptnd);
isexisted:=true;
finally
end;
end;
procedure Icon_CHANGE (hdlg:integer;strin:String;iconname:TIcon);
begin
if Isexisted then
try
new (ptnd);
ptnd.cbsize:=sizeof(TNOTIFYICONDATAA);
strPcopy(ptnd.szTip,strin);
ptnd.uCallbackMessage:=MYWM_NOTIFYICON;
ptnd.uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
Ptnd.uID:=IDC_NOTIFY;
Ptnd.hIcon:=Iconname.Handle;
Ptnd.Wnd:=hdlg;
Shell_notifyIcona(NIM_MODIFY,ptnd);
dispose(ptnd);
isexisted:=true;
finally
end;
end;
procedure Icon_DELETE (hdlg:integer);
begin
if Isexisted then
try
new (ptnd);
ptnd.cbsize:=sizeof(TNOTIFYICONDATAA);
ptnd.uCallbackMessage:=MYWM_NOTIFYICON;
ptnd.uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
Ptnd.uID:=IDC_NOTIFY;
Ptnd.Wnd:=hdlg;
Shell_notifyIcona(NIM_DELETE,ptnd);
dispose(ptnd);
isexisted:=false;
finally
end;
end;
procedure SetIconStatus(WinHandle,IcnoStatus:Integer;Const DispStr:String;ilStatus:TImageList);
Var
NewIcon:TIcon;
Begin
NewIcon:=TIcon.Create;
ilStatus.GetIcon(IcnoStatus,NewIcon);
Icon_Change (WinHandle,DispStr,NewIcon);
NewIcon.Free;
End;
调用方法:
uses un_Notifyicon;
type
TfrmMain = class(TForm)
ImageList1: TImageList;
PopupMenu1: TPopupMenu;
public
{ Public declarations }
Procedure On_My_Notifyicon(var mess:TMESSAGE);Message MYWM_NOTIFYICON;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
Var
NewIcon:TIcon;
begin
NewIcon:=TIcon.Create;
ImageList1.GetIcon(0,NewIcon); //取第一个图标
Icon_Add (frmMain.WindowHandle,Self.caption,NewIcon); //在右下角加入图标
NewIcon.Free;
end;
procedure TfrmMain.FormDestroy(Sender: TObject); //释放
begin
Icon_DELETE(frmMain.WindowHandle);
end;
Procedure TfrmMain.On_My_Notifyicon(var mess:TMESSAGE);
Begin
inherited;
case Mess.lParam of
WM_LBUTTONDBLCLK,
WM_LBUTTONUP,
WM_RBUTTONUP:
Begin
PopupMenu1.Popup(screen.width-80,screen.height); //PopupMenu1是你加入的菜单,你自已自定内容吧
End;
end;
End;
自定义响应图标的消息:
Const WM_TRAYNOTIFY=WM_USER+1;
加入响应该消息的函数:
procedure TFormfychatmain.WndProc(var Msg: TMessage);
var
pt:TPOINT;
iconID: integer;
begin
if msg.Msg = WM_TRAYNOTIFY then
begin
iconID := msg.WParam; // wParam参数为图标的uID,lParam参数为鼠标事件的类型
GetCursorPos(pt); //获取鼠标的在屏幕上的位置
//通知消息的处理的基本框架结构:
case msg.lParam of
WM_LBUTTONDOWN: //鼠标左键被按下
begin
end;
WM_RBUTTONDOWN: //鼠标右键被按下
begin
end;
WM_LBUTTONUP: //释放鼠标左键
begin
end;
WM_RBUTTONUP: //释放鼠标右键
begin
end;
WM_MOUSEMOVE: //鼠标在图标上移动
begin //修改提示信息
information:='Little Icon';
StrPLCopy(nd.szTip, information, 20);
Shell_NotifyIcon(NIM_MODIFY, @nd);
end;
WM_LBUTTONDBLCLK: //鼠标左键双击
begin
popupmenu1.Popup(pt.x,pt.y); //弹出一个popmenu
end;
WM_RBUTTONDBLCLK: //鼠标右键双击
begin
end;
end; //end case
end
else //调用父类的WndProc方法处理其它消息
inherited;
end;