type
TIconManager=class
private
FHWindow:HWnd;
procedure TrayWndProc(var Message:TMessage);
Public
Constructor Create;
//////////////////////////////////////////////
Destructor Destroy;override;
property HWindow:HWnd read FHWindow write FHWindow;
end;
var
IconMgr:TIconManager;
DDGM_TRAYICON:Integer;
constructor TIconManager.create;
begin
FHWindow:=AllocateHWnd(TrayWndProc);
end;
destructor TIconManager.destroy;
begin
if FHWindow<>0 then DeallocateHWnd(FHwindow);
inherited destroy;
end;
procedure TIconManager.TrayWndProc(var Message:TMessage);
var
Pt:TPoint;
TheIcon:TTrayNotifyIcon;
begin
with Message do
begin
if (Msg=DDGM_TRAYICON) then
////////////////////////////////////////////
begin
TheIcon:=TTrayNotifyIcon(WParam);
case lParam of
/////////////////////////////////
WM_LBUTTONDOWN:TheIcon.FTimer.enabled:=true;
//////////////////////
WM_LBUTTONDBLCLK:
begin
TheIcon.FNoShowClick:=true;
if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblclick(self);
end;
/////////////////////////////
WM_RBUTTONDOWN:
begin
if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(Self);
begin
SetForegroundWindow(IconMgr.HWindow);
GetCursorPos(Pt);
TheIcon.FPopupMenu.Popup(Pt.x,Pt.y);
PostMessage(IconMgr.HWindow,Wm_user,0,0);
end;
end;
end;
end
else
Result:=DefWindowProc(FHWindow,Msg,wParam,lParam);
end;
end;
procedure Register;
begin
RegisterComponents('DSGTrayIcon', [TTrayNotifyIcon]);
end;
{ TTrayNotifyIcon }
function TTrayNotifyIcon.ActiveIconHandle: THandle;
begin
if (FIcon.Handle<>0) then
result:=FIcon.Handle
else
Result:=FDefaultIcon;
end;
constructor TTrayNotifyIcon.Create(Aowner: Tcomponent);
begin
inherited Create(AOwner);
FIcon:=TIcon.create;
FTimer:=TTimer.Create(self);
with FTimer do
begin
Enabled:=False;
Interval:=GetDoubleClickTime;
OnTimer:=OnButtonTimer;
end;
end;
destructor TTrayNotifyIcon.Destroy;
begin
if FIconVisible then SetIconVisible(False);
FIcon.Free;
Ftimer.Free;
inherited Destroy;
end;
procedure TTrayNotifyIcon.LoadDefaultIcon;
begin
FDefaultIcon:=LoadIcon(0,IDI_WINLOGO);
end;
procedure TTrayNotifyIcon.Loaded;
begin
inherited Loaded;
if FIconVisible then
SendTrayMessage(NIM_ADD,NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;
procedure TTrayNotifyIcon.Notification(AComponent: Tcomponent;
Operation: Toperation);
begin
inherited Notification(AComponent,Operation);
if (Operation = opRemove) and (AComponent = PopupMenu) then
PopupMenu:=nil;
end;
procedure TTrayNotifyIcon.OnButtonTimer(sender: Tobject);
begin
FTimer.enabled:=False;
if (not FNoShowClick) and Assigned(FOnClick) then
FOnClick(self);
FNoShowClick:=false;
end;
procedure TTrayNotifyIcon.SendTrayMessage(Msg
WORD;Flags:UINT);
begin
with Tnd do
begin
cbSize:=Sizeof(Tnd);
StrPlCopy(szTip,Pchar(FHint),SizeOf(szTip));
uFlags:=Flags;
uID:=UINT(Self);
Wnd:=IconMgr.HWindow;
uCallbackMessage:=DDGM_TRAYICON;
hIcon:=ActiveIconHandle;
end;
Shell_NotifyIcon(Msg,@Tnd);
end;
procedure TTrayNotifyIcon.SetHideTask(Value: Boolean);
const
ShowArray:array[Boolean] of integer=(sw_ShowNormal,sw_Hide);
begin
if FHideTask <>Value then
begin
FHideTask:=Value;
if not (csDesigning in ComponentState) then
ShowWindow(Application.handle,ShowArray[FHideTask]);
end;
end;
procedure TTrayNotifyIcon.SetHint(value: String);
begin
if FHint<>value then
begin
FHint:=value;
if FIconVisible then
SendTrayMessage(NIM_MODIFY,NIF_TIP);
end;
end;
procedure TTrayNotifyIcon.SetIcon(value: TIcon);
begin
FIcon.Assign(Value);
if FIconVisible then
SendTrayMessage(NIM_MODIFY,NIF_ICON);
end;
procedure TTrayNotifyIcon.SetIconVisible(value: Boolean);
const
MsgArray:array[boolean] of DWORD=(NIM_DELETE,NIM_ADD);
begin
if FIconVisible<>Value then
begin
FIconVisible:=Value;
SendTrayMessage(MsgArray[value],NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;
end;
procedure TTrayNotifyIcon.SetPopupMenu(value: TPopupmenu);
begin
FPopupMenu:=Value;
if Value <>nil then value.FreeNotification(Self);
end;
const
TrayMsgStr='DDG.TrayNotifyIconMsg';
//IconMgr:TiconManager;
initialization
DDGM_TRAYICON:=RegisterWindowmessage(TrayMsgStr);
IconMgr:=TIconManager.create;
finalization
IconMgr.free;
end.