最近在溫故Delphi精要,下面是按照其中作的托盤圖標組件,記錄一下。ide
工具:Delphi 7+Image Editer工具
先上圖:spa
組件源碼以下:對於圖標,百度 code
unit XsdTrayIcon; interface uses SysUtils, Classes, Windows, Messages, Graphics, Menus, ShellAPI, ExtCtrls, Forms, Registry; const ICON_ID = 1; MI_ICONEVENT = WM_USER + 1; //自定義一個消息 type TXsdTrayIcon = class(TComponent) private FHint: string; FOnDblClick: TNotifyEvent; FTrayIcon: TIcon; FPopMenu: TPopupMenu; FNotificationWnd: HWND; FStartAtBoot: Boolean; FInterval: Cardinal; TimerHandle: LongWord; NotifyIconData: TNotifyIconData; OldWindowProc: TWndMethod; procedure NotificationWndProc(var Message: TMessage); procedure SetTrayIcon(const Value: TIcon); procedure SetStartAtBoot(const Value: Boolean); procedure Registry(B: Boolean); procedure NewWindowProc(var Message: TMessage); protected procedure DoDblClick; procedure Notification(AComponent: TComponent; Operation: TOperation); override; (* Loaded 是TComponent 的一個虛擬方法。當全部組件被建立,並從dfm 文件讀出數據 初始化這些組件實例後,Loaded 方法被自動調用。在Loaded 中能夠進行額外的初始化 工做,能夠對組件實例的一些成員進行改變、嫁接 *) procedure Loaded; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; //操做托盤正常顯示應用程序 procedure RestoreAPP(); procedure ShowTrayIcon(Mode: Cardinal = NIM_ADD; Animated: Boolean = False); published property Hint: string read FHint write FHint; property OnDoDblClick: TNotifyEvent read FOnDblClick write FOnDblClick; property PopMenu: TPopupMenu read FPopMenu write FPopMenu; property TrayIcon: TIcon read FTrayIcon write SetTrayIcon; //是否自動啓動 property StartAtBoot: Boolean read FStartAtBoot write SetStartAtBoot; property Interval: Cardinal read FInterval write FInterval; end; procedure Register; implementation var FXsdTrayIcon: TXsdTrayIcon ; procedure Register; begin RegisterComponents('XsdInfo', [TXsdTrayIcon]); end; { TXsdTrayIcon } constructor TXsdTrayIcon.Create(AOwner: TComponent); begin inherited Create(AOwner); FXsdTrayIcon := Self; FTrayIcon := TIcon.Create; FInterval := 500; TimerHandle := 0; FNotificationWnd := Classes.AllocateHWnd(NotificationWndProc); if AOwner is TForm then begin OldWindowProc := TForm(AOwner).WindowProc; TForm(AOwner).WindowProc := NewWindowProc; end; end; destructor TXsdTrayIcon.Destroy; begin ShowTrayIcon(NIM_DELETE); //刪除托盤圖標 FreeAndNil(FTrayIcon); if FNotificationWnd<>0 then Classes.DeallocateHWnd(FNotificationWnd); //銷燬窗口 if TimerHandle<>0 then KillTimer(0, TimerHandle); //關掉定時器 inherited Destroy; end; procedure TXsdTrayIcon.DoDblClick; begin if Assigned(OnDoDblClick) then OnDoDblClick(Self); end; procedure TXsdTrayIcon.Loaded; begin inherited; if not (csDesigning in ComponentState) then begin if FTrayIcon.Handle=0 then FTrayIcon.Assign(Application.Icon); //初始化NotifiCationData; FillChar(NotifyIconData, SizeOf(NotifyIconData), 0); with NotifyIconData do begin cbSize := SizeOf(TNotifyIconData); Wnd := FNotificationWnd; uID := ICON_ID; uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP; uCallbackMessage := MI_ICONEVENT; hIcon := FTrayIcon.Handle; StrLCopy(szTip, PChar(FHint), SizeOf(szTip)); end; ShowTrayIcon(); end; end; procedure TXsdTrayIcon.NewWindowProc(var Message: TMessage); begin if Assigned(OldWindowProc) then OldWindowProc(Message); with Message do begin if ((Msg=WM_SYSCOMMAND) and (WParam=SC_MINIMIZE)) then ShowWindow(Application.Handle, SW_HIDE); end; end; procedure TXsdTrayIcon.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if Operation=opRemove then begin if AComponent=FPopMenu then FPopMenu := nil; end; end; procedure TXsdTrayIcon.NotificationWndProc(var Message: TMessage); var PT: TPoint; begin if Message.Msg=MI_ICONEVENT then begin case Message.LParam of WM_LBUTTONDBLCLK: begin DoDblClick; RestoreAPP; end; WM_RBUTTONDOWN: begin if Assigned(FPopMenu) then begin GetCursorPos(PT); FPopMenu.Popup(PT.X, PT.Y); end; end; end; end else //對於其它消息 缺省處理。 Message.Result := DefWindowProc(FNotificationWnd, Message.Msg, message.WParam, message.LParam); end; procedure SetAnimatedIcon(Wnd: HWND; Msg, idEvent: UINT; dwTime: DWORD); stdcall; begin if Msg=wm_timer then with FXsdTrayIcon.NotifyIconData do begin if hIcon=0 then hIcon := FXsdTrayIcon.FTrayIcon.Handle else hIcon := 0; Shell_NotifyIcon(NIM_MODIFY, @FXsdTrayIcon.NotifyIconData); end; end; procedure TXsdTrayIcon.Registry(B: Boolean); var Reg: TRegistry; KeyName: string; begin Reg := TRegistry.Create; KeyName := ExtractFileName(Application.ExeName); try Reg.RootKey := HKEY_LOCAL_MACHINE; if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run', False) then begin if B then Reg.WriteString(KeyName, Application.ExeName) else Reg.DeleteKey(KeyName); Reg.CloseKey; end; finally FreeAndNil(Reg); end; end; procedure TXsdTrayIcon.RestoreAPP; begin ShowTrayIcon(NIM_MODIFY, False); ShowWindow(Application.Handle, SW_SHOWNORMAL); ShowWindow(Application.MainForm.Handle, SW_SHOWNORMAL); SetForegroundWindow(Application.MainForm.Handle); end; procedure TXsdTrayIcon.SetStartAtBoot(const Value: Boolean); begin if FStartAtBoot<>Value then begin FStartAtBoot := Value; if not (csDesigning in ComponentState) then Registry(FStartAtBoot); end; end; procedure TXsdTrayIcon.SetTrayIcon(const Value: TIcon); begin FTrayIcon := Value; end; procedure TXsdTrayIcon.ShowTrayIcon(Mode: Cardinal; Animated: Boolean); begin if csDesigning in ComponentState then Exit; if Mode=NIM_MODIFY then begin if Animated then begin if TimerHandle=0 then TimerHandle := SetTimer(0, 0, FInterval, @SetAnimatedIcon); end else begin if TimerHandle<>0 then begin KillTimer(0, TimerHandle); TimerHandle := 0; NotifyIconData.hIcon := FTrayIcon.Handle; end; end; end; Shell_NotifyIcon(Mode, @NotifyIconData); end; end.