{------------------------------------------------------------------------------}
{ 單元名稱: TrayIcon.pas/t/t/t/t/t/t       }
{/t/t/t/t/t/t/t/t/t      }
{ 單元作者: savetime (savetime2k@hotmail.com, http://savetime.delphibbs.com)   }
{ 創建日期: 2004-11-13 12:20:54/t/t/t/t/t/t}
{/t/t/t/t/t/t/t/t/t      }
{ 功能介紹:/t/t/t/t/t/t/t/t    }
{   封裝 Shell_NotifyIcon 的大部分功能,并增加部分常見應用/t/t      }
{/t/t/t/t/t/t/t/t/t      }
{ 使用說明:/t/t/t/t/t/t/t/t    }
{   如果設置了 OnDblClick 事件,則 onClick 的響應時間會增加 GetDoubleClickTime. }
{   否則, onClick 將會立即執行./t/t/t/t/t/t}
{   如果沒有設置 Icon, 將使用 Application 的圖標./t/t/t      }
{/t/t/t/t/t/t/t/t/t      }
{ 更新歷史:/t/t/t/t/t/t/t/t    }
{   彈出右鍵菜單時,點擊其他位置不能關閉該菜單.解決方法:/t/t/t}
{     在彈出菜單之前加上: SetForegroundWindow(FWindow); 即可./t/t  }
{/t/t/t/t/t/t/t/t/t      }
{ 尚存問題:/t/t/t/t/t/t/t/t    }
{   暫時只支持 Win95 Shell 風格, Version 5.0 新功能以后加入/t/t    }
{   DoubleClick 的間隔時間應可隨系統設置更改而更新./t/t/t    }
{   點擊 TrayIcon 時,應可設置是否將應用程序提至前臺./t/t/t   }
{/t/t/t/t/t/t/t/t/t      }
{------------------------------------------------------------------------------}
unit TrayIcon;

interface

uses SysUtils, Classes, Graphics, Controls, Windows, Messages, Forms, Menus,
 ExtCtrls, ShellAPI;

type

//==============================================================================
// TTrayIcon class
//==============================================================================

 TTrayIcon = class(TComponent)
 private
   FWindow: HWND;
   FHint: string;
   FIcon: TIcon;
   FActive: Boolean;
   FonClick: TNotifyEvent;
   FOnDblClick: TNotifyEvent;
   FPopupMenu: TPopupMenu;
   FClickTimer: TTimer;
   FIconData: TNotifyIconData;
   procedure CheckClickTimer(Sender: TObject);
   procedure SendTrayMessage(MsgID: DWORD; Flags: UINT);
   procedure TrayWndProc(var Message: TMessage);
   procedure SetActive(const Value: Boolean);
   procedure SetIcon(const Value: TIcon);
   procedure SetHint(const Value: string);
   procedure SetPopupMenu(const Value: TPopupMenu);
 protected
   procedure Loaded; override;
   procedure Notification(AComponent: TComponent; Operation: TOperation); override;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
   property Active: Boolean read FActive write SetActive default False;
   property Hint: string read FHint write SetHint;
   property Icon: TIcon read FIcon write SetIcon;
   property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
   property onClick: TNotifyEvent read FonClick write FonClick;
   property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
 end;

 procedure Register;

implementation

procedure Register;
begin
 RegisterComponents(''Savetime'', [TTrayIcon]);
end;

{ TTrayIcon }

const
 WM_CALLBACKMESSAGE = WM_USER + 100;     // 托盤圖標回調消息常量

procedure TTrayIcon.CheckClickTimer(Sender: TObject);
begin
 FClickTimer.Enabled := False;
 if Assigned(FonClick) then FonClick(Self);
end;

constructor TTrayIcon.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);

 FWindow := Classes.AllocateHWnd(TrayWndProc); // 處理 TrayIcon 消息的窗口

 FIcon := TIcon.Create;

 FClickTimer := TTimer.Create(Self);/t   // 處理單擊和雙擊間隔時間的定時器
 FClickTimer.Enabled := False;
 FClickTimer.Interval := GetDoubleClickTime;   // 控制面板中鼠標雙擊間隔時間
 FClickTimer.OnTimer := CheckClickTimer;

 FIconData.cbSize := SizeOf(FIconData);/t// 初始化 NotifyIconData 結構
 FIconData.Wnd := FWindow;
 FIconData.uID := UINT(Self);
 FIconData.uCallbackMessage := WM_CALLBACKMESSAGE;
end;

destructor TTrayIcon.Destroy;
begin
 Active := False;

 FClickTimer.Free;
 FIcon.Free;
 Classes.DeallocateHWnd(FWindow);

 inherited;
end;

procedure TTrayIcon.Loaded;
begin
 inherited;
 if FActive then
   SendTrayMessage(NIM_ADD, NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;

procedure TTrayIcon.Notification(AComponent: TComponent; Operation: TOperation);
begin
 inherited Notification(AComponent, Operation);
 if (Operation = opRemove) and (AComponent = PopupMenu) then
   PopupMenu := nil;
end;

procedure TTrayIcon.SendTrayMessage(MsgID: DWORD; Flags: UINT);
begin
 if (Flags and NIF_ICON) <> 0 then
 begin
   if FIcon.Handle = 0 then/t/t      // 如果未設置圖標,則使用缺省圖標
     FIconData.hIcon := Application.Icon.Handle
   else
     FIconData.hIcon := FIcon.Handle;
 end;

 FIconData.uFlags := Flags;
 Shell_NotifyIcon(MsgID, @FIconData);
end;

procedure TTrayIcon.SetActive(const Value: Boolean);
begin
 FActive := Value;

 if (not (csDesigning in ComponentState)) and
    (not (csLoading in ComponentState))  then
 begin
   if Value then
     SendTrayMessage(NIM_ADD, NIF_MESSAGE or NIF_ICON or NIF_TIP)
   else
     SendTrayMessage(NIM_DELETE, 0)
 end;
end;

procedure TTrayIcon.SetHint(const Value: string);
begin
 FHint := Value;
 StrPLCopy(FIconData.szTip, PChar(FHint), SizeOf(FIconData.szTip));

 if (not (csDesigning in ComponentState)) and
    (not (csLoading in ComponentState)) and
    FActive then
 begin
   SendTrayMessage(NIM_MODIFY, NIF_TIP);
 end;
end;

procedure TTrayIcon.SetIcon(const Value: TIcon);
begin
 FIcon.Assign(Value);

 if (FActive and not (csDesigning in ComponentState)) then
   SendTrayMessage(NIM_MODIFY, NIF_ICON);
end;

procedure TTrayIcon.SetPopupMenu(const Value: TPopupMenu);
begin
 FPopupMenu := Value;
 if Value <> nil then Value.FreeNotification(Self);
end;

procedure TTrayIcon.TrayWndProc(var Message: TMessage);
var
 PT: TPoint;
begin
 with Message do
 begin
   if Msg = WM_CALLBACKMESSAGE then
   begin
     case LParam of

/tWM_LBUTTONDOWN:
/tbegin
/t  // 如果沒設置 OnDblClick 事件,則直接調用 onclick
/t  if not Assigned(FOnDblClick) then
/t  begin
/t    if Assigned(FonClick) then FonClick(Self);
/t  end
/t  else  // 否則使用時間判斷雙擊時間是否到達
/t    FClickTimer.Enabled := True;
/tend;

/tWM_LBUTTONDBLCLK:
/tbegin
/t  FClickTimer.Enabled := False;
/t  if Assigned(FOnDblClick) then FOnDblClick(Self);
/tend;

/tWM_RBUTTONDOWN:
/tbegin
/t  if Assigned(FPopupMenu) then
/t  begin
/t    SetForegroundWindow(FWindow); // 這句一定要加,否則彈出菜單不會自動隱藏
/t    GetCursorPos(PT);
/t    FPopupMenu.Popup(PT.X, PT.Y);
/t  end;
/tend;
     end;
   end
   else    // 其他消息交由 Windows 處理
     Result := DefWindowProc(FWindow, Msg, WParam, LParam);
 end;
end;

end.