unit MyTray;
interface
uses
Windows,Messages,SysUtils,Classes,Graphics,Controls,
Forms,Dialogs,ShellApi,ExtCtrls,StdCtrls;
const
//自定义托盘消息
WM_TrayMsg=WM_USER+10;
type
//恢复窗口的方式，左双击，右双击，左单击，右双击
TRMode=(LDbClick,RDbClick,LCLick,RClick);
TMyTray=class(TComponent)
private
{ Private declarations }
//私有成员
FIcon:TIcon;//图标
FDfIcon:THandle;//应用程序的默认图标
FSetDfIcon:Boolean;//是否用应用程序的图标，如果为True，则Ficon为nil
FIconData:TNotifyIconData;//托盘数据结构
isMin:Boolean;//标识是否窗口最小化了
FHandle:HWnd;//不可视建窗体句柄,用于处理托盘事件
FActive:Boolean;//是否启用托盘
FHint:string;//托盘提示字符串
FRMode:TRMode;//恢复窗口的方式
isClickIn:Boolean;//标识鼠标是否点在图标上
OldStyleEX:longInt;//保存老的窗口风格
//事件成员
FOnIconClick:TNotifyEvent;
FOnIconDblClick:TNotifyEvent;
FOnIconMouseMove:TMouseMoveEvent;
FOnIconMouseDown:TMouseEvent;
FOnIconMouseUp:TMouseEvent;
//设置方法
procedure SetIcon(value:TIcon);
procedure SetDfIcon(value:boolean);
procedure SetActive(value:boolean);
procedure SetHint(value:string);
procedure SetRMode(value:TRMode);
//私有方法
procedure SetTray(Way:DWORD);//设置托盘样式,修改,删除,增加
function GetActiveIcon:THandle;//取得有用的图标句柄
protected
{ Protected declarations }
//应用程序的消息钩子，获得主窗口的最小化消息
function AppMsgHook(var Msg:TMessage):Boolean;
procedure WndProc(var Msg:TMessage);//不可视窗口的窗口过程
//以下为事件的调度函数
procedure DblClick;dynamic;
procedure Click;dynamic;
procedure MouseDown(Button:TMouseButton;Shift:TShiftState;X,Y:Integer);dynamic;
procedure MouseUp(Button:TMouseButton;Shift:TShiftState;X,Y:Integer);dynamic;
procedure MouseMove(Shift:TShiftState;X,Y:Integer);dynamic;
public
{ Public declarations }
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
published
{ Published declarations }
property Active:Boolean read FActive write SetActive default False;
property Icon:TIcon read FIcon write SetICon;
property SetDfIconed:boolean read FSetDfIcon write SetDfIcon default true;
property Hint:String read FHint write SetHint;
property RMode:TRmode read FRmode write SetRMode default LDbClick;
//事件的方法指针
property OnIconClick:TNotifyEvent read FOnIconClick write FOnIconClick;
property OnIconDblClick:TNotifyEvent read FOnIconDblClick write FOnIconDblClick;
property OnIconMouseMove:TMouseMoveEvent read FOnIconMouseMove write FOnIconMouseMove;
property OnIconMouseDown:TMouseEvent read FOnIconMouseDown write FOnIconMouseDown;
property OnIconMouseUp:TMouseEvent read FOnIconMouseUp write FOnIconMouseUp;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TMyTray]);
end;
///////////TmyTray////////////////////////////
constructor TMyTray.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
//设置程序钩子,指定AppMsgHook为处理函数,
//则,应用程序的任何消息都将经过这个函数
Application.HookMainWindow(AppMsgHook);
FICon:=TICon.Create;
//得到默认图标的句柄，图标为应用程序的图标
FDfIcon:=Application.Icon.Handle;
FSetDfIcon:=True;
FActive:=False;
FRMode:=LDbClick;
isMin:=False;
//创建一个不可视窗口，并指定窗口过程，以处理托盘事件
FHandle:=AllocateHWnd(WndProc);
//保存窗体的老的风格,在恢复窗口的同时也恢复原来的窗口风格
OldStyleEX:=GetWindowLong(Application.Handle,GWL_EXSTYLE);
end;
destructor TMyTray.Destroy;
begin
Application.UnhookMainWindow(AppMsgHook);
//对象释放之前先消除托盘
SetTray(NIM_DELETE);
//释放不可能窗口的句柄
DeallocateHWnd(FHandle);
FICon.Free;
inherited Destroy;
end;
//应用程序钩子,可以截获应用程序的所有消息
function TMyTray.AppMsgHook(var Msg:TMessage):Boolean;
var
placement:WINDOWPLACEMENT;
begin
Result:=False;
//保证程序不会在设计时处理最小化消息
if not (csDesigning in ComponentState) then
if (Msg.Msg=WM_SYSCOMMAND) and (FActive) then
begin
if msg.WParam=SC_MINIMIZE then
begin
//设置了这个属性后,窗口最小化就不会停在任务栏了,而是停在屏幕,
//位置由SetWindowPlacement来决定
ShowWindow(Application.Handle,SW_HIDE);
SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
GetWindowPlacement(Application.Handle,@placement);
placement.flags:=WPF_SETMINPOSITION;
placement.ptMinPosition.x:=1800;
placement.ptMinPosition.y:=1200;
SetWindowPlacement(Application.Handle,@placement);
SetTray(NIM_ADD);
end;
end;
end;
procedure TMyTray.SetIcon(Value:TIcon);
begin
FIcon.Assign(Value);
FsetDfIcon:=False;//有了自定义的图标,则默认图标自动设为False
if FIcon.Empty then
FsetDfIcon:=True;
if (isMin)and(Factive) then
SetTray(NIM_MODifY);
end;
//设置是否为默认图标,与FIcon为互相的变量,只能有其中一个
procedure TMyTray.SetDfIcon(Value:Boolean);
begin
if FSetDfIcon<>Value then
begin
FSetDfIcon:=Value;
if not FSetDfIcon then
begin
if FIcon.Empty then
begin
FSetDfIcon:=True;
exit;
end;
end
else
begin
if (IsMin)and(FActive) then
SetTray(NIM_MODifY);
end;
end;
end;
procedure TMyTray.SetActive(Value:Boolean);
begin
if FActive<>Value then
begin
FActive:=Value;
end;
end;
procedure TMyTray.SetHint(Value:String);
begin
if FHint<>Value then
begin
FHInt:=Value;
if (IsMin)and(FActive) then
SetTray(NIM_MODifY);
end;
end;
procedure TMyTray.SetRMode(Value:TRMode);
begin
if FRmode<>Value then
FRmode:=Value;
end;
//设置托盘方式,显示,修改,删掉,重要方法
procedure TMyTray.SetTray(Way:DWORD);
begin
FIconData.cbSize:=Sizeof(FIconData);
FIconData.Wnd:=FHandle;
FIConData.uID:=0;
FIConData.uFlags:=Nif_ICON or Nif_MESSAGE or Nif_TIP;
FIConData.uCallbackMessage:=WM_TrayMsg;
FIConData.hIcon:=GetActiveIcon;
StrLCopy(FIConData.szTip,Pchar(FHint),63);
Shell_NotifyIcon(Way,@FIconData);
end;
//取得可用的图标
function TMyTray.GetActiveIcon:THandle;
begin
if not FSetDfIcon then
result:=FIcon.Handle
else
result:=FDfIcon;
end;
//托盘消息的截获,以调用相应的事件调度方法
procedure TMyTray.WndProc(var Msg:TMessage);
var
p:TPoint;
begin
if (Msg.Msg=WM_TrayMsg)and(FActive) then
begin
case Msg.LParam of
WM_LBUTTONDBLCLK://左双击
begin
GetCursorPos(p);
DblClick;
MouseDown(mbLeft,KeysToShiftState(TWMMouse(Msg).Keys)+[ssDouble],P.X,P.Y);
if FRmode=LDbclick then
begin
ShowWindow(Application.Handle,SW_SHOW);
//这里很重要的一个就是恢复窗口风格,不然下次把Active设为True
//最小化后,窗口依然会往左下角飞去,而托盘图标却看不见了.
SetWindowLong(Application.Handle,GWL_EXSTYLE,OldStyleEX);
SendMessage(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);
SetTray(NIM_DELETE);
end;
end;
WM_RBUTTONDBLCLK://右双击
begin
GetCursorPos(P);
DblClick;
MouseDown(mbRight,KeysToShiftState(TWMMouse(Msg).Keys)+[ssDouble],P.X,P.Y);
if FRmode=RDbclick then
begin
ShowWindow(Application.Handle,SW_SHOW);
SetWindowLong(Application.Handle,GWL_EXSTYLE,OldStyleEX);
SendMessage(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);
SetTray(NIM_DELETE);
end;
end;
WM_MOUSEMOVE://鼠标移动
begin
GetCursorPos(P);
MouseMove(KeysToShiftState(TWMMouse(Msg).Keys),P.X,P.Y);
end;
WM_LBUTTONDOWN://左单击下
begin
GetCursorPos(P);
IsClickIn:=True;
MouseDown(mbLeft,KeysToShiftState(TWMMouse(Msg).Keys)+[ssLeft],P.X,P.Y);
end;
WM_LBUTTONUP://左单击弹起
begin
GetCursorPos(P);
if IsClickIn then
begin
IsClickIn:=False;
Click;
if FRmode=LClick then
begin
ShowWindow(Application.Handle,SW_SHOW);
SetWindowLong(Application.Handle,GWL_EXSTYLE,OldStyleEX);
SendMessage(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);
SetTray(NIM_DELETE);
end;
end;
MouseUp(mbLeft,KeysToShiftState(TWMMouse(Msg).Keys)+[ssLeft],P.X,P.Y);
end;
WM_RBUTTONDOWN://右单击下
begin
GetCursorPos(P);
IsClickIn:=True;
MouseDown(mbRight,KeysToShiftState(TWMMouse(Msg).Keys)+[ssRight],P.X,P.Y);
end;
WM_RBUTTONUP://右单击弹起
begin
GetCursorPos(P);
if IsClickIn then
begin
IsClickIn:=False;
Click;
if FRmode=RClick then
begin
ShowWindow(Application.Handle,SW_SHOW);
SetWindowLong(Application.Handle,GWL_EXSTYLE,OldStyleEX);
SendMessage(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);
SetTray(NIM_DELETE);
end;
end;
MouseUp(mbRight,KeysToShiftState(TWMMouse(Msg).Keys)+[ssRight],P.X,P.Y);
end;
end;
end
else
Msg.Result:=DefWindowProc(FHandle,Msg.Msg,Msg.wParam,Msg.lParam);
end;
//以下为几个事件的调度函数,比较简单.
procedure TMyTray.DblClick;
begin
if Assigned(FOnIconDblClick) then
FOnIconDblClick(Self);
end;
procedure TMyTray.Click;
begin
if Assigned(FOnIconClick) then
FOnIconClick(Self);
end;
procedure TMyTray.MouseDown(Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
begin
if Assigned(FOnIconMouseDown) then
FOnIconMouseDown(Self,Button,Shift,X,Y);
end;
procedure TMyTray.MouseUp(Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
begin
if Assigned(FOnIconMouseUp) then
FOnIconMouseUp(Self,Button,Shift,X,Y);
end;
procedure TMyTray.MouseMove(Shift:TShiftState;X,Y:Integer);
begin
if Assigned(FOnIconMouseMove) then
FOnIconMouseMove(Self,Shift,X,Y);
end;
end.