unit Unit_TrayIcon;
interface
uses
Windows, SysUtils, Messages, ShellAPI, Classes, Graphics, Forms, Menus,
StdCtrls, ExtCtrls;
type
TTrayNotifyIcon = class
private
Tray: TNotifyIconData;
FHWindow: HWND;
ActiveIcon: THandle;
Fimage: TImage;
FPopMenu: TPopupMenu;
FTitle: string;
public
constructor Create(AOwer: TComponent);
destructor Destroy; override;
procedure TrayShow;
procedure TrayWndProc(var Msg: TMessage);
procedure SetImage(Value: TImage);
property Image: TImage read FImage write SetImage;
property PopMenu: TPopupMenu read FPopMenu write FPopMenu;
property Title: string read FTitle write FTitle;
end;
implementation
{ TTrayNotifyIcon }
constructor TTrayNotifyIcon.Create(AOwer: TComponent);
begin
// 为TrayWndProc消息处理方法指定一个隐藏的窗口句柄
FHWindow := AllocateHWnd(TrayWndProc);
ActiveIcon := Application.Icon.Handle;
TrayShow;
Shell_NotifyIcon(NIM_ADD, @Tray);
end;
destructor TTrayNotifyIcon.Destroy;
begin
// 为TrayWndProc消息处理方法指定一个隐藏的窗口句柄
DeallocateHWnd(FHWindow);
Shell_NotifyIcon(NIM_DELETE, @Tray);
inherited Destroy;
end;
// 通过Image属性更改托盘图标当前所显示的图标
procedure TTrayNotifyIcon.SetImage(Value: TImage);
begin
if Assigned(Value) then
if Value <> Fimage then
begin
Fimage := Value;
ActiveIcon := Fimage.Picture.Icon.Handle;
TrayShow;
Shell_NotifyIcon(NIM_MODIFY, @Tray);
end;
end;
// 配置托盘图标所使用的结构信息
procedure TTrayNotifyIcon.TrayShow;
begin
Tray.cbSize := SizeOf(Tray);
Tray.Wnd := FHWindow;
Tray.uID := 100;
Tray.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
Tray.uCallbackMessage := WM_USER + 1000;
StrPCopy(Tray.szTip, Title);
// Tray.szTip := Title;
Tray.hIcon := ActiveIcon;
end;
// 消息处理方法: 用于获取对托盘的鼠标事件
procedure TTrayNotifyIcon.TrayWndProc(var Msg: TMessage);
var
P: TPoint;
begin
case Msg.LParam of
WM_LBUTTONDOWN:
begin
//单击
end;
WM_LBUTTONDBLCLK:
begin
//双击
end;
WM_RBUTTONDOWN:
begin
if Assigned(PopMenu) then
begin
GetCursorPos(p);
PopMenu.Popup(p.X, p.Y);
end;
end;
end;
end;
end.
主窗体中的调用方法:
procedure TFrmServer.FormCreate(Sender: TObject);
begin
NotifIco:=TTrayNotifyIcon.Create(Self);
NotifIco.PopMenu := PopupMenu1;
end;
procedure TFrmServer.FormDestroy(Sender: TObject);
begin
NotifIco.Free;
end;
procedure TFrmServer.N1Click(Sender: TObject);
begin
Close;
end;