{------------------------------------------------- -----------------------------}
{ 單元名稱: TrayIcon.pas/t/t/t/t/t/t }
{/t/t/t/t/t/t/t/t/t }
{ 單元作者: savetime ([email protected], 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.