可以很簡單的几行代碼就行, 但當然不完整!以下是我見到的一個考慮的比較完整的代碼, 你安裝後直接操作那個控件就可了!!要不然, 使用其中有用的代碼也好!{*****************************************************************} { This is a component for placing icons in the notification area } { of the Windows taskbar (aka. the traybar). } { } { The component is freeware. Feel free to use and improve it. } { I would be pleased to hear what you think. } { } { Troels Jakobsen - [email protected] } { Copyright (c) 2001 } {*****************************************************************}unit CoolTrayIcon;interfaceuses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus, ShellApi, ExtCtrls;const { Define user-defined message sent by the trayicon. We avoid low user-defined messages that are used by Windows itself (eg. WM_USER+1 = DM_SETDEFID). } WM_TRAYNOTIFY = WM_USER + 1024; // Constant used for recreating trayicon on system traybar recover IconID = 1; // Constants used for balloon hint feature WM_RESETTOOLTIP = WM_USER + 1025; NIIF_NONE = $00000000; NIIF_INFO = $00000001; NIIF_WARNING = $00000002; NIIF_ERROR = $00000003; NIF_INFO = $00000010;var WM_TASKBARCREATED: Cardinal;type { You can use the TNotifyIconData record structure defined in shellapi.pas. However, WinME, Win2000, and WinXP have expanded this structure. We define a similar structure, TNotifyIconDataEx. } TNotifyIconDataEx = record cbSize: DWORD; Wnd: HWND; uID: UINT; uFlags: UINT; uCallbackMessage: UINT; hIcon: HICON; // szTip: array[0..63] of AnsiChar; szTip: array[0..127] of AnsiChar; // 0..63 of WideChar in stead? dwState: DWORD; dwStateMask: DWORD; szInfo: array[0..255] of AnsiChar; uTimeout: UINT; // union with uVersion: UINT; szInfoTitle: array[0..63] of AnsiChar; dwInfoFlags: DWORD; end; TBalloonHintIcon = (bitNone, bitInfo, bitWarning, bitError); TBalloonHintTimeOut = 10..60; // Windows defines 10-60 secs. as min-max TCycleEvent = procedure(Sender: TObject; NextIndex: Integer) of object; TCoolTrayIcon = class(TComponent) private FEnabled: Boolean; FIcon: TIcon; FIconVisible: Boolean; FHint: string; FShowHint: Boolean; FPopupMenu: TPopupMenu; FLeftPopup: Boolean; FOnClick, FOnDblClick: TNotifyEvent; FOnCycle: TCycleEvent; FOnMouseDown, FOnMouseUp: TMouseEvent; FOnMouseMove: TMouseMoveEvent; FStartMinimized: Boolean; FMinimizeToTray: Boolean; FClickStart: Boolean; CycleTimer: TTimer; // For icon cycling FIconIndex: Integer; // Current index in imagelist FDesignPreview: Boolean; SettingPreview: Boolean; // Internal status flag SettingMDIForm: Boolean; // Internal status flag FIconList: TImageList; FCycleIcons: Boolean; FCycleInterval: Cardinal; OldAppProc, NewAppProc: Pointer; // Procedure variables OldWndProc, NewWndProc: Pointer; // Procedure variables FWindowHandle: HWND; // Window handle (not general handle) procedure SetDesignPreview(Value: Boolean); procedure SetCycleIcons(Value: Boolean); procedure SetCycleInterval(Value: Cardinal); procedure TimerCycle(Sender: TObject); procedure HandleIconMessage(var Msg: TMessage); function InitIcon: Boolean; procedure SetIcon(Value: TIcon); procedure SetIconVisible(Value: Boolean); procedure SetIconList(Value: TImageList); procedure SetIconIndex(Value: Integer); procedure SetHint(Value: string); procedure SetShowHint(Value: Boolean); procedure PopupAtCursor; // Hook methods procedure HookApp; procedure UnhookApp; procedure HookAppProc(var Msg: TMessage); procedure HookForm; procedure UnhookForm; procedure HookFormProc(var Msg: TMessage); protected IconData: TNotifyIconDataEx; // Data of the tray icon wnd. procedure Loaded; override; function LoadDefaultIcon: Boolean; virtual; function ShowIcon: Boolean; virtual; function HideIcon: Boolean; virtual; function ModifyIcon: Boolean; virtual; procedure Click; dynamic; procedure DblClick; dynamic; procedure CycleIcon; 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; procedure DoMinimizeToTray; dynamic; procedure Notification(AComponent: TComponent; Operation: TOperation); override; public {$IFDEF DFS_CPPB_3_UP} property Handle: HWND read IconData.hWnd; {$ELSE} property Handle: HWND read IconData.Wnd; {$ENDIF} property WindowHandle: HWND read FWindowHandle; constructor Create(AOwner: TComponent); override; destructor Destroy; override; function Refresh: Boolean; function ShowBalloonHint(Title: string; Text: string; IconType: TBalloonHintIcon; TimeoutSecs: TBalloonHintTimeOut): Boolean; function BitmapToIcon(const Bitmap: TBitmap; const Icon: TIcon; MaskColor: TColor): Boolean; //----- SPECIAL: methods that only apply when owner is a form ----- procedure ShowMainForm; procedure HideMainForm; //----- END SPECIAL ----- published // Properties: property DesignPreview: Boolean read FDesignPreview write SetDesignPreview default False; property IconList: TImageList read FIconList write SetIconList; property CycleIcons: Boolean read FCycleIcons write SetCycleIcons default False; property CycleInterval: Cardinal read FCycleInterval write SetCycleInterval; property Enabled: Boolean read FEnabled write FEnabled default True; property Hint: string read FHint write SetHint; property ShowHint: Boolean read FShowHint write SetShowHint default True; property Icon: TIcon read FIcon write SetIcon stored True; property IconVisible: Boolean read FIconVisible write SetIconVisible default True; property IconIndex: Integer read FIconIndex write SetIconIndex; property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu; property LeftPopup: Boolean read FLeftPopup write FLeftPopup default False; //----- SPECIAL: properties that only apply when owner is a form ----- property StartMinimized: Boolean read FStartMinimized write FStartMinimized default False; // Main form minimized on app. start-up? property MinimizeToTray: Boolean read FMinimizeToTray write FMinimizeToTray default False; // Minimize main form to tray when minimizing? //----- END SPECIAL ----- // Events: property OnClick: TNotifyEvent read FOnClick write FOnClick; property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick; property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown; property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp; property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove; property OnCycle: TCycleEvent read FOnCycle write FOnCycle; end;procedure Register;
implementation{------------------- TCoolTrayIcon --------------------}constructor TCoolTrayIcon.Create(AOwner: TComponent); begin inherited Create(AOwner); SettingMDIForm := True; FIconVisible := True; // Visible by default FEnabled := True; // Enabled by default FShowHint := True; // Show hint by default SettingPreview := False; // Use the TaskbarCreated message available from Win98/IE4+ WM_TASKBARCREATED := RegisterWindowMessage('TaskbarCreated'); FIcon := TIcon.Create; IconData.cbSize := SizeOf(TNotifyIconDataEx); // IconData.wnd points to procedure to receive callback messages from the icon IconData.wnd := AllocateHWnd(HandleIconMessage); // Add an id for the tray icon IconData.uId := IconID; // We want icon, message handling, and tooltips by default IconData.uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP; // Message to send to IconData.wnd when event occurs IconData.uCallbackMessage := WM_TRAYNOTIFY; FWindowHandle := GetWindowLong(IconData.wnd, GWL_HWNDPARENT); CycleTimer := TTimer.Create(Self); CycleTimer.Enabled := False; CycleTimer.Interval := FCycleInterval; CycleTimer.OnTimer := TimerCycle; { Assign a default icon if Icon property is empty. This will assign an icon to the component when it is created for the very first time. When the user assigns another icon it will not be overwritten next time the project loads. HOWEVER, if the user has decided explicitly to have no icon a default icon will be inserted regardless. I figured this was a tolerable price to pay. } if (csDesigning in ComponentState) then if FIcon.Handle = 0 then if LoadDefaultIcon then FIcon.Handle := LoadIcon(0, IDI_WINLOGO); { It is tempting to assign the application's icon (Application.Icon) as a default icon. The problem is there's no Application instance at design time. Or is there? Yes there is: the Delphi editor! Application.Icon is the icon found in delphi32.exe. How to use: FIcon.Assign(Application.Icon); } // Set hook(s) if not (csDesigning in ComponentState) then begin HookApp; // Hook into the app.'s message handling if Owner is TWinControl then HookForm; // Hook into the main form's message handling end; end; destructor TCoolTrayIcon.Destroy; begin SetIconVisible(False); // Remove the icon from the tray SetDesignPreview(False); // Remove any DesignPreview icon FIcon.Free; // Free the icon DeallocateHWnd(IconData.Wnd); // Free the tray window CycleTimer.Free; // It is important to unhook any hooked processes if not (csDesigning in ComponentState) then begin UnhookApp; if Owner is TWinControl then UnhookForm; end; inherited Destroy; end; procedure TCoolTrayIcon.Loaded; { This method is called when all properties of the component have been initialized. The method SetIconVisible must be called here, after the tray icon (FIcon) has loaded itself. Otherwise, the tray icon will be blank (no icon image). } begin inherited Loaded; // Always call inherited Loaded first if Owner is TWinControl then if (FStartMinimized) and not (csDesigning in ComponentState) then begin Application.ShowMainForm := False; ShowWindow(Application.Handle, SW_HIDE); end; ModifyIcon; SetIconVisible(FIconVisible); end; function TCoolTrayIcon.LoadDefaultIcon: Boolean; { This method is called to determine whether to assign a default icon to the component. Descendant classes (like TextTrayIcon) can override the method to change this behavior. } begin Result := True; end; procedure TCoolTrayIcon.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); { Check if either the imagelist or the popup menu is about to be deleted } if (AComponent = IconList) and (Operation = opRemove) then begin FIconList := nil; IconList := nil; end; if (AComponent = PopupMenu) and (Operation = opRemove) then begin FPopupMenu := nil; PopupMenu := nil; end; end; { For MinimizeToTray to work, we need to know when the form is minimized (happens when either the application or the main form minimizes). The straight-forward way is to make TCoolTrayIcon trap the Application.OnMinimize event. However, if you also make use of this event in the application, the OnMinimize code used by TCoolTrayIcon is discarded. The solution is to hook into the app.'s message handling (via HookApp). You can then catch any message that goes through the app. and still use the OnMinimize event. }procedure TCoolTrayIcon.HookApp; begin // Hook the application OldAppProc := Pointer(GetWindowLong(Application.Handle, GWL_WNDPROC)); NewAppProc := MakeObjectInstance(HookAppProc); SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(NewAppProc)); end; procedure TCoolTrayIcon.UnhookApp; begin if Assigned(OldAppProc) then SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldAppProc)); if Assigned(NewAppProc) then FreeObjectInstance(NewAppProc); NewAppProc := nil; OldAppProc := nil; end; { All app. messages pass through HookAppProc. You can override the messages by not passing them along to Windows (via CallWindowProc). }procedure TCoolTrayIcon.HookAppProc(var Msg: TMessage); begin case Msg.Msg of WM_SIZE: // Handle MinimizeToTray by capturing app's minimize events if Msg.wParam = SIZE_MINIMIZED then begin if FMinimizeToTray then DoMinimizeToTray; { You could insert a call to a custom minimize event here, but it would behave exactly like Application.OnMinimize, so I see no need for it. } end; WM_WINDOWPOSCHANGED: begin { Handle MDI forms (MDI children cause app. to be redisplayed on taskbar. We hide it again. This may cause a quick flicker (?)). } if SettingMDIForm then if Application.MainForm <> nil then begin if Application.MainForm.FormStyle = fsMDIForm then if FStartMinimized then ShowWindow(Application.Handle, SW_HIDE); SettingMDIForm := False; // So we only do this once end; end; end; { Show the tray icon if the taskbar has been re-created after an Explorer crash. } if Msg.Msg = WM_TASKBARCREATED then if FIconVisible then ShowIcon; // Pass the message on Msg.Result := CallWindowProc(OldAppProc, Application.Handle, Msg.Msg, Msg.wParam, Msg.lParam); end; { You can hook into the main form (or any other window) just as easily as hooking into the app., allowing you to handle any message that window processes. This is necessary in order to properly handle when the user minimizes the form using the TASKBAR icon. }procedure TCoolTrayIcon.HookForm; begin if (Owner as TWinControl) <> nil then begin // Hook the parent window OldWndProc := Pointer(GetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC)); NewWndProc := MakeObjectInstance(HookFormProc); SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(NewWndProc)); end; end; procedure TCoolTrayIcon.UnhookForm; begin if ((Owner as TWinControl) <> nil) and (Assigned(OldWndProc)) then SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(OldWndProc)); if Assigned(NewWndProc) then FreeObjectInstance(NewWndProc); NewWndProc := nil; OldWndProc := nil; end;{ All main form messages pass through HookFormProc. You can override the messages by not passing them along to Windows (via CallWindowProc). You should be careful with the graphical messages, though. }
procedure TCoolTrayIcon.HookFormProc(var Msg: TMessage); begin case Msg.Msg of WM_SHOWWINDOW: begin if (Msg.lParam = 0) and (Msg.wParam = 1) then begin // Show the taskbar icon (Windows may have shown it already) ShowWindow(Application.Handle, SW_RESTORE); // Bring the taskbar icon and the main form to the foreground SetForegroundWindow(Application.Handle); SetForegroundWindow((Owner as TWinControl).Handle); end; end; { WM_WINDOWPOSCHANGED: begin // Bring any modal forms owned by the main form to the foreground if Assigned(Screen.ActiveControl) then SetFocus(Screen.ActiveControl.Handle); end; } WM_ACTIVATE: begin // Bring any modal forms owned by the main form to the foreground if Assigned(Screen.ActiveControl) then if (Msg.WParamLo = WA_ACTIVE) or (Msg.WParamLo = WA_CLICKACTIVE) then if Assigned(Screen.ActiveControl.Parent) then begin // Control on modal form is active if HWND(Msg.lParam) <> Screen.ActiveControl.Parent.Handle then SetFocus(Screen.ActiveControl.Handle); end else begin // Modal form itself is active if HWND(Msg.lParam) <> Screen.ActiveControl.Handle then SetFocus(Screen.ActiveControl.Handle); end; end; end; // Pass the message on Msg.Result := CallWindowProc(OldWndProc, (Owner as TWinControl).Handle, Msg.Msg, Msg.wParam, Msg.lParam); end; { HandleIconMessage handles messages that go to the shell notification window (tray icon) itself. Most messages are passed through WM_TRAYNOTIFY. In these cases use lParam to get the actual message, eg. WM_MOUSEMOVE. The method sends the usual Delphi events for the mouse messages. It also interpolates the OnClick event when the user clicks the left button, and makes the menu (if any) popup on left and right mouse down events. }procedure TCoolTrayIcon.HandleIconMessage(var Msg: TMessage); function ShiftState: TShiftState; // Return the state of the shift, ctrl, and alt keys begin Result := []; if GetAsyncKeyState(VK_SHIFT) < 0 then Include(Result, ssShift); if GetAsyncKeyState(VK_CONTROL) < 0 then Include(Result, ssCtrl); if GetAsyncKeyState(VK_MENU) < 0 then Include(Result, ssAlt); end;var Pt: TPoint; Shift: TShiftState; I: Integer; M: TMenuItem; begin if Msg.Msg = WM_TRAYNOTIFY then // Take action if a message from the icon comes through begin case Msg.lParam of WM_MOUSEMOVE: if FEnabled then begin Shift := ShiftState; GetCursorPos(Pt); MouseMove(Shift, Pt.X, Pt.Y); end; WM_LBUTTONDOWN: if FEnabled then begin Shift := ShiftState + [ssLeft]; GetCursorPos(Pt); MouseDown(mbLeft, Shift, Pt.X, Pt.Y); FClickStart := True; if FLeftPopup then PopupAtCursor; end; WM_RBUTTONDOWN: if FEnabled then begin Shift := ShiftState + [ssRight]; GetCursorPos(Pt); MouseDown(mbRight, Shift, Pt.X, Pt.Y); PopupAtCursor; end; WM_MBUTTONDOWN: if FEnabled then begin Shift := ShiftState + [ssMiddle]; GetCursorPos(Pt); MouseDown(mbMiddle, Shift, Pt.X, Pt.Y); end; WM_LBUTTONUP: if FEnabled then begin Shift := ShiftState + [ssLeft]; GetCursorPos(Pt); if FClickStart then // Then WM_LBUTTONDOWN was called before begin FClickStart := False; Click; // We have a click end; MouseUp(mbLeft, Shift, Pt.X, Pt.Y); end; WM_RBUTTONUP: if FEnabled then begin Shift := ShiftState + [ssRight]; GetCursorPos(Pt); MouseUp(mbRight, Shift, Pt.X, Pt.Y); end; WM_MBUTTONUP: if FEnabled then begin Shift := ShiftState + [ssMiddle]; GetCursorPos(Pt); MouseUp(mbMiddle, Shift, Pt.X, Pt.Y); end; WM_LBUTTONDBLCLK: if FEnabled then begin DblClick; { Handle default menu items. But only if LeftPopup is false, or it will conflict with the popupmenu, when it is called by a click event. } M := nil; if Assigned(FPopupMenu) then if (FPopupMenu.AutoPopup) and (not FLeftPopup) then for I := PopupMenu.Items.Count - 1 downto 0 do begin if PopupMenu.Items[I].Default then M := PopupMenu.Items[I]; end; if M <> nil then M.Click; end; end; end else // Messages that didn't go through the icon case Msg.Msg of { Windows sends us a WM_QUERYENDSESSION message when it prepares for shutdown. Msg.Result must not return 0, or the system will be unable to shut down. } WM_QUERYENDSESSION: begin Msg.Result := 1; end; else // Handle all other messages with the default handler Msg.Result := DefWindowProc(IconData.Wnd, Msg.Msg, Msg.wParam, Msg.lParam); end; end; procedure TCoolTrayIcon.SetIcon(Value: TIcon); begin FIcon.Assign(Value); ModifyIcon; end; procedure TCoolTrayIcon.SetIconVisible(Value: Boolean); begin if Value then ShowIcon else HideIcon; end; procedure TCoolTrayIcon.SetDesignPreview(Value: Boolean); begin FDesignPreview := Value; SettingPreview := True; // Raise flag SetIconVisible(Value); SettingPreview := False; // Clear flag end; procedure TCoolTrayIcon.SetCycleIcons(Value: Boolean); begin FCycleIcons := Value; if Value then SetIconIndex(0); CycleTimer.Enabled := Value; end; procedure TCoolTrayIcon.SetCycleInterval(Value: Cardinal); begin FCycleInterval := Value; CycleTimer.Interval := FCycleInterval; end; procedure TCoolTrayIcon.SetIconList(Value: TImageList); begin FIconList := Value; { // Set CycleIcons = false if IconList is nil if Value = nil then SetCycleIcons(False); } SetIconIndex(0); end; procedure TCoolTrayIcon.SetIconIndex(Value: Integer); begin if FIconList <> nil then begin FIconIndex := Value; if Value >= FIconList.Count then FIconIndex := FIconList.Count - 1; FIconList.GetIcon(FIconIndex, FIcon); end else FIconIndex := 0; ModifyIcon; end; procedure TCoolTrayIcon.SetHint(Value: string); begin FHint := Value; ModifyIcon; end; procedure TCoolTrayIcon.SetShowHint(Value: Boolean); begin FShowHint := Value; ModifyIcon; end;
你看看api函数Shell_NotifyIcon后应该没问题的
用控件会比较简单 比如cooltray
先定义结构 type TNotifyIconData = record cbSize: DWORD; Wnd: HWND; uID: UINT; uFlags: UINT; uCallbackMessage: UINT; hIcon: HICON; szTip: array [0..63] of AnsiChar; end;定义函数，函数名随便，处理鼠标点到托盘图标后处理事件 procedure IconTray(var Msg:TMessage); Message WM_command;procedure Tmemform.IconTray(var Msg:Tmessage); var pt:TPoint; begin if Msg.LParam=wm_rbuttondown then //鼠标右键 begin GetCursorPos(pt); SetForeGroundWindow(Handle); PopupMenu1.Popup(pt.x,pt.y); end; if Msg.LParam=wm_lbuttondblclk then //鼠标左键 begin showwindow(Handle,sw_ShowNormal); setforegroundwindow(Handle); show; end; end; 窗口创建函数中加 nid.cbSize:=sizeof(nid); nid.Wnd:=Handle; nid.uID:=1; nid.uCallbackMessage:=wm_command; nid.hIcon:=Icon.Handle; nid.szTip:='鼠标移到托盘图标上显示的提示文本'; nid.uFlags:=nif_message or nif_Icon or nif_Tip; Shell_NotifyIcon(NIM_Add,@nid);关闭程序释放托盘图标 procedure Tmemform.FormDestroy(Sender: TObject); begin nid.uFlags:=0; Shell_NotifyIcon(NIM_DELETE,@nid); end;差不多就ok了
{ This is a component for placing icons in the notification area }
{ of the Windows taskbar (aka. the traybar). }
{ }
{ The component is freeware. Feel free to use and improve it. }
{ I would be pleased to hear what you think. }
{ }
{ Troels Jakobsen - [email protected] }
{ Copyright (c) 2001 }
{*****************************************************************}unit CoolTrayIcon;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Menus, ShellApi, ExtCtrls;const
{ Define user-defined message sent by the trayicon. We avoid low user-defined
messages that are used by Windows itself (eg. WM_USER+1 = DM_SETDEFID). }
WM_TRAYNOTIFY = WM_USER + 1024;
// Constant used for recreating trayicon on system traybar recover
IconID = 1;
// Constants used for balloon hint feature
WM_RESETTOOLTIP = WM_USER + 1025;
NIIF_NONE = $00000000;
NIIF_INFO = $00000001;
NIIF_WARNING = $00000002;
NIIF_ERROR = $00000003;
NIF_INFO = $00000010;var
WM_TASKBARCREATED: Cardinal;type
{ You can use the TNotifyIconData record structure defined in shellapi.pas.
However, WinME, Win2000, and WinXP have expanded this structure. We define
a similar structure, TNotifyIconDataEx. }
TNotifyIconDataEx = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
// szTip: array[0..63] of AnsiChar;
szTip: array[0..127] of AnsiChar; // 0..63 of WideChar in stead?
dwState: DWORD;
dwStateMask: DWORD;
szInfo: array[0..255] of AnsiChar;
uTimeout: UINT; // union with uVersion: UINT;
szInfoTitle: array[0..63] of AnsiChar;
dwInfoFlags: DWORD;
end; TBalloonHintIcon = (bitNone, bitInfo, bitWarning, bitError);
TBalloonHintTimeOut = 10..60; // Windows defines 10-60 secs. as min-max TCycleEvent = procedure(Sender: TObject; NextIndex: Integer) of object; TCoolTrayIcon = class(TComponent)
private
FEnabled: Boolean;
FIcon: TIcon;
FIconVisible: Boolean;
FHint: string;
FShowHint: Boolean;
FPopupMenu: TPopupMenu;
FLeftPopup: Boolean;
FOnClick,
FOnDblClick: TNotifyEvent;
FOnCycle: TCycleEvent;
FOnMouseDown,
FOnMouseUp: TMouseEvent;
FOnMouseMove: TMouseMoveEvent;
FStartMinimized: Boolean;
FMinimizeToTray: Boolean;
FClickStart: Boolean;
CycleTimer: TTimer; // For icon cycling
FIconIndex: Integer; // Current index in imagelist
FDesignPreview: Boolean;
SettingPreview: Boolean; // Internal status flag
SettingMDIForm: Boolean; // Internal status flag
FIconList: TImageList;
FCycleIcons: Boolean;
FCycleInterval: Cardinal;
OldAppProc, NewAppProc: Pointer; // Procedure variables
OldWndProc, NewWndProc: Pointer; // Procedure variables
FWindowHandle: HWND; // Window handle (not general handle)
procedure SetDesignPreview(Value: Boolean);
procedure SetCycleIcons(Value: Boolean);
procedure SetCycleInterval(Value: Cardinal);
procedure TimerCycle(Sender: TObject);
procedure HandleIconMessage(var Msg: TMessage);
function InitIcon: Boolean;
procedure SetIcon(Value: TIcon);
procedure SetIconVisible(Value: Boolean);
procedure SetIconList(Value: TImageList);
procedure SetIconIndex(Value: Integer);
procedure SetHint(Value: string);
procedure SetShowHint(Value: Boolean);
procedure PopupAtCursor;
// Hook methods
procedure HookApp;
procedure UnhookApp;
procedure HookAppProc(var Msg: TMessage);
procedure HookForm;
procedure UnhookForm;
procedure HookFormProc(var Msg: TMessage);
protected
IconData: TNotifyIconDataEx; // Data of the tray icon wnd.
procedure Loaded; override;
function LoadDefaultIcon: Boolean; virtual;
function ShowIcon: Boolean; virtual;
function HideIcon: Boolean; virtual;
function ModifyIcon: Boolean; virtual;
procedure Click; dynamic;
procedure DblClick; dynamic;
procedure CycleIcon; 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;
procedure DoMinimizeToTray; dynamic;
procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
public
{$IFDEF DFS_CPPB_3_UP}
property Handle: HWND read IconData.hWnd;
{$ELSE}
property Handle: HWND read IconData.Wnd;
{$ENDIF}
property WindowHandle: HWND read FWindowHandle;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Refresh: Boolean;
function ShowBalloonHint(Title: string; Text: string; IconType: TBalloonHintIcon;
TimeoutSecs: TBalloonHintTimeOut): Boolean;
function BitmapToIcon(const Bitmap: TBitmap; const Icon: TIcon;
MaskColor: TColor): Boolean;
//----- SPECIAL: methods that only apply when owner is a form -----
procedure ShowMainForm;
procedure HideMainForm;
//----- END SPECIAL -----
published
// Properties:
property DesignPreview: Boolean read FDesignPreview
write SetDesignPreview default False;
property IconList: TImageList read FIconList write SetIconList;
property CycleIcons: Boolean read FCycleIcons write SetCycleIcons
default False;
property CycleInterval: Cardinal read FCycleInterval
write SetCycleInterval;
property Enabled: Boolean read FEnabled write FEnabled default True;
property Hint: string read FHint write SetHint;
property ShowHint: Boolean read FShowHint write SetShowHint
default True;
property Icon: TIcon read FIcon write SetIcon stored True;
property IconVisible: Boolean read FIconVisible write SetIconVisible
default True;
property IconIndex: Integer read FIconIndex write SetIconIndex;
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
property LeftPopup: Boolean read FLeftPopup write FLeftPopup
default False;
//----- SPECIAL: properties that only apply when owner is a form -----
property StartMinimized: Boolean read FStartMinimized write FStartMinimized
default False; // Main form minimized on app. start-up?
property MinimizeToTray: Boolean read FMinimizeToTray write FMinimizeToTray
default False; // Minimize main form to tray when minimizing?
//----- END SPECIAL -----
// Events:
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnCycle: TCycleEvent read FOnCycle write FOnCycle;
end;procedure Register;
begin
inherited Create(AOwner);
SettingMDIForm := True;
FIconVisible := True; // Visible by default
FEnabled := True; // Enabled by default
FShowHint := True; // Show hint by default
SettingPreview := False; // Use the TaskbarCreated message available from Win98/IE4+
WM_TASKBARCREATED := RegisterWindowMessage('TaskbarCreated'); FIcon := TIcon.Create;
IconData.cbSize := SizeOf(TNotifyIconDataEx);
// IconData.wnd points to procedure to receive callback messages from the icon
IconData.wnd := AllocateHWnd(HandleIconMessage);
// Add an id for the tray icon
IconData.uId := IconID;
// We want icon, message handling, and tooltips by default
IconData.uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
// Message to send to IconData.wnd when event occurs
IconData.uCallbackMessage := WM_TRAYNOTIFY; FWindowHandle := GetWindowLong(IconData.wnd, GWL_HWNDPARENT); CycleTimer := TTimer.Create(Self);
CycleTimer.Enabled := False;
CycleTimer.Interval := FCycleInterval;
CycleTimer.OnTimer := TimerCycle; { Assign a default icon if Icon property is empty. This will assign
an icon to the component when it is created for the very first time.
When the user assigns another icon it will not be overwritten next
time the project loads. HOWEVER, if the user has decided explicitly
to have no icon a default icon will be inserted regardless.
I figured this was a tolerable price to pay. }
if (csDesigning in ComponentState) then
if FIcon.Handle = 0 then
if LoadDefaultIcon then
FIcon.Handle := LoadIcon(0, IDI_WINLOGO);
{ It is tempting to assign the application's icon (Application.Icon)
as a default icon. The problem is there's no Application instance
at design time. Or is there? Yes there is: the Delphi editor!
Application.Icon is the icon found in delphi32.exe. How to use:
FIcon.Assign(Application.Icon); } // Set hook(s)
if not (csDesigning in ComponentState) then
begin
HookApp; // Hook into the app.'s message handling
if Owner is TWinControl then
HookForm; // Hook into the main form's message handling
end;
end;
destructor TCoolTrayIcon.Destroy;
begin
SetIconVisible(False); // Remove the icon from the tray
SetDesignPreview(False); // Remove any DesignPreview icon
FIcon.Free; // Free the icon
DeallocateHWnd(IconData.Wnd); // Free the tray window
CycleTimer.Free;
// It is important to unhook any hooked processes
if not (csDesigning in ComponentState) then
begin
UnhookApp;
if Owner is TWinControl then
UnhookForm;
end;
inherited Destroy;
end;
procedure TCoolTrayIcon.Loaded;
{ This method is called when all properties of the component have been
initialized. The method SetIconVisible must be called here, after the
tray icon (FIcon) has loaded itself. Otherwise, the tray icon will
be blank (no icon image). }
begin
inherited Loaded; // Always call inherited Loaded first
if Owner is TWinControl then
if (FStartMinimized) and not (csDesigning in ComponentState) then
begin
Application.ShowMainForm := False;
ShowWindow(Application.Handle, SW_HIDE);
end;
ModifyIcon;
SetIconVisible(FIconVisible);
end;
function TCoolTrayIcon.LoadDefaultIcon: Boolean;
{ This method is called to determine whether to assign a default
icon to the component. Descendant classes (like TextTrayIcon) can
override the method to change this behavior. }
begin
Result := True;
end;
procedure TCoolTrayIcon.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
{ Check if either the imagelist or the popup menu is about
to be deleted }
if (AComponent = IconList) and (Operation = opRemove) then
begin
FIconList := nil;
IconList := nil;
end;
if (AComponent = PopupMenu) and (Operation = opRemove) then
begin
FPopupMenu := nil;
PopupMenu := nil;
end;
end;
{ For MinimizeToTray to work, we need to know when the form is minimized
(happens when either the application or the main form minimizes).
The straight-forward way is to make TCoolTrayIcon trap the
Application.OnMinimize event. However, if you also make use of this
event in the application, the OnMinimize code used by TCoolTrayIcon
is discarded.
The solution is to hook into the app.'s message handling (via HookApp).
You can then catch any message that goes through the app. and still
use the OnMinimize event. }procedure TCoolTrayIcon.HookApp;
begin
// Hook the application
OldAppProc := Pointer(GetWindowLong(Application.Handle, GWL_WNDPROC));
NewAppProc := MakeObjectInstance(HookAppProc);
SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(NewAppProc));
end;
procedure TCoolTrayIcon.UnhookApp;
begin
if Assigned(OldAppProc) then
SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldAppProc));
if Assigned(NewAppProc) then
FreeObjectInstance(NewAppProc);
NewAppProc := nil;
OldAppProc := nil;
end;
{ All app. messages pass through HookAppProc. You can override the
messages by not passing them along to Windows (via CallWindowProc). }procedure TCoolTrayIcon.HookAppProc(var Msg: TMessage);
begin
case Msg.Msg of WM_SIZE:
// Handle MinimizeToTray by capturing app's minimize events
if Msg.wParam = SIZE_MINIMIZED then
begin
if FMinimizeToTray then
DoMinimizeToTray;
{ You could insert a call to a custom minimize event here, but it
would behave exactly like Application.OnMinimize, so I see no
need for it. }
end; WM_WINDOWPOSCHANGED: begin
{ Handle MDI forms (MDI children cause app. to be redisplayed on
taskbar. We hide it again. This may cause a quick flicker (?)). }
if SettingMDIForm then
if Application.MainForm <> nil then
begin
if Application.MainForm.FormStyle = fsMDIForm then
if FStartMinimized then
ShowWindow(Application.Handle, SW_HIDE);
SettingMDIForm := False; // So we only do this once
end;
end; end; { Show the tray icon if the taskbar has been re-created after an
Explorer crash. }
if Msg.Msg = WM_TASKBARCREATED then
if FIconVisible then
ShowIcon; // Pass the message on
Msg.Result := CallWindowProc(OldAppProc, Application.Handle,
Msg.Msg, Msg.wParam, Msg.lParam);
end;
{ You can hook into the main form (or any other window) just as easily
as hooking into the app., allowing you to handle any message that
window processes.
This is necessary in order to properly handle when the user minimizes
the form using the TASKBAR icon. }procedure TCoolTrayIcon.HookForm;
begin
if (Owner as TWinControl) <> nil then
begin
// Hook the parent window
OldWndProc := Pointer(GetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC));
NewWndProc := MakeObjectInstance(HookFormProc);
SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(NewWndProc));
end;
end;
procedure TCoolTrayIcon.UnhookForm;
begin
if ((Owner as TWinControl) <> nil) and (Assigned(OldWndProc)) then
SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(OldWndProc));
if Assigned(NewWndProc) then
FreeObjectInstance(NewWndProc);
NewWndProc := nil;
OldWndProc := nil;
end;{ All main form messages pass through HookFormProc. You can override the
messages by not passing them along to Windows (via CallWindowProc).
You should be careful with the graphical messages, though. }
begin
case Msg.Msg of WM_SHOWWINDOW: begin
if (Msg.lParam = 0) and (Msg.wParam = 1) then
begin
// Show the taskbar icon (Windows may have shown it already)
ShowWindow(Application.Handle, SW_RESTORE);
// Bring the taskbar icon and the main form to the foreground
SetForegroundWindow(Application.Handle);
SetForegroundWindow((Owner as TWinControl).Handle);
end;
end;
{
WM_WINDOWPOSCHANGED: begin
// Bring any modal forms owned by the main form to the foreground
if Assigned(Screen.ActiveControl) then
SetFocus(Screen.ActiveControl.Handle);
end;
}
WM_ACTIVATE: begin
// Bring any modal forms owned by the main form to the foreground
if Assigned(Screen.ActiveControl) then
if (Msg.WParamLo = WA_ACTIVE) or (Msg.WParamLo = WA_CLICKACTIVE) then
if Assigned(Screen.ActiveControl.Parent) then
begin
// Control on modal form is active
if HWND(Msg.lParam) <> Screen.ActiveControl.Parent.Handle then
SetFocus(Screen.ActiveControl.Handle);
end
else
begin
// Modal form itself is active
if HWND(Msg.lParam) <> Screen.ActiveControl.Handle then
SetFocus(Screen.ActiveControl.Handle);
end;
end; end;
// Pass the message on
Msg.Result := CallWindowProc(OldWndProc, (Owner as TWinControl).Handle,
Msg.Msg, Msg.wParam, Msg.lParam);
end;
{ HandleIconMessage handles messages that go to the shell notification
window (tray icon) itself. Most messages are passed through WM_TRAYNOTIFY.
In these cases use lParam to get the actual message, eg. WM_MOUSEMOVE.
The method sends the usual Delphi events for the mouse messages. It also
interpolates the OnClick event when the user clicks the left button, and
makes the menu (if any) popup on left and right mouse down events. }procedure TCoolTrayIcon.HandleIconMessage(var Msg: TMessage); function ShiftState: TShiftState;
// Return the state of the shift, ctrl, and alt keys
begin
Result := [];
if GetAsyncKeyState(VK_SHIFT) < 0 then
Include(Result, ssShift);
if GetAsyncKeyState(VK_CONTROL) < 0 then
Include(Result, ssCtrl);
if GetAsyncKeyState(VK_MENU) < 0 then
Include(Result, ssAlt);
end;var
Pt: TPoint;
Shift: TShiftState;
I: Integer;
M: TMenuItem;
begin
if Msg.Msg = WM_TRAYNOTIFY then
// Take action if a message from the icon comes through
begin
case Msg.lParam of WM_MOUSEMOVE:
if FEnabled then
begin
Shift := ShiftState;
GetCursorPos(Pt);
MouseMove(Shift, Pt.X, Pt.Y);
end; WM_LBUTTONDOWN:
if FEnabled then
begin
Shift := ShiftState + [ssLeft];
GetCursorPos(Pt);
MouseDown(mbLeft, Shift, Pt.X, Pt.Y);
FClickStart := True;
if FLeftPopup then
PopupAtCursor;
end; WM_RBUTTONDOWN:
if FEnabled then
begin
Shift := ShiftState + [ssRight];
GetCursorPos(Pt);
MouseDown(mbRight, Shift, Pt.X, Pt.Y);
PopupAtCursor;
end; WM_MBUTTONDOWN:
if FEnabled then
begin
Shift := ShiftState + [ssMiddle];
GetCursorPos(Pt);
MouseDown(mbMiddle, Shift, Pt.X, Pt.Y);
end; WM_LBUTTONUP:
if FEnabled then
begin
Shift := ShiftState + [ssLeft];
GetCursorPos(Pt);
if FClickStart then // Then WM_LBUTTONDOWN was called before
begin
FClickStart := False;
Click; // We have a click
end;
MouseUp(mbLeft, Shift, Pt.X, Pt.Y);
end; WM_RBUTTONUP:
if FEnabled then
begin
Shift := ShiftState + [ssRight];
GetCursorPos(Pt);
MouseUp(mbRight, Shift, Pt.X, Pt.Y);
end; WM_MBUTTONUP:
if FEnabled then
begin
Shift := ShiftState + [ssMiddle];
GetCursorPos(Pt);
MouseUp(mbMiddle, Shift, Pt.X, Pt.Y);
end; WM_LBUTTONDBLCLK:
if FEnabled then
begin
DblClick;
{ Handle default menu items. But only if LeftPopup is false,
or it will conflict with the popupmenu, when it is called
by a click event. }
M := nil;
if Assigned(FPopupMenu) then
if (FPopupMenu.AutoPopup) and (not FLeftPopup) then
for I := PopupMenu.Items.Count - 1 downto 0 do
begin
if PopupMenu.Items[I].Default then
M := PopupMenu.Items[I];
end;
if M <> nil then
M.Click;
end;
end;
end else // Messages that didn't go through the icon
case Msg.Msg of
{ Windows sends us a WM_QUERYENDSESSION message when it prepares
for shutdown. Msg.Result must not return 0, or the system will
be unable to shut down. }
WM_QUERYENDSESSION: begin
Msg.Result := 1;
end;
else // Handle all other messages with the default handler
Msg.Result := DefWindowProc(IconData.Wnd, Msg.Msg, Msg.wParam, Msg.lParam);
end;
end;
procedure TCoolTrayIcon.SetIcon(Value: TIcon);
begin
FIcon.Assign(Value);
ModifyIcon;
end;
procedure TCoolTrayIcon.SetIconVisible(Value: Boolean);
begin
if Value then
ShowIcon
else
HideIcon;
end;
procedure TCoolTrayIcon.SetDesignPreview(Value: Boolean);
begin
FDesignPreview := Value;
SettingPreview := True; // Raise flag
SetIconVisible(Value);
SettingPreview := False; // Clear flag
end;
procedure TCoolTrayIcon.SetCycleIcons(Value: Boolean);
begin
FCycleIcons := Value;
if Value then
SetIconIndex(0);
CycleTimer.Enabled := Value;
end;
procedure TCoolTrayIcon.SetCycleInterval(Value: Cardinal);
begin
FCycleInterval := Value;
CycleTimer.Interval := FCycleInterval;
end;
procedure TCoolTrayIcon.SetIconList(Value: TImageList);
begin
FIconList := Value;
{
// Set CycleIcons = false if IconList is nil
if Value = nil then
SetCycleIcons(False);
}
SetIconIndex(0);
end;
procedure TCoolTrayIcon.SetIconIndex(Value: Integer);
begin
if FIconList <> nil then
begin
FIconIndex := Value;
if Value >= FIconList.Count then
FIconIndex := FIconList.Count - 1;
FIconList.GetIcon(FIconIndex, FIcon);
end
else
FIconIndex := 0; ModifyIcon;
end;
procedure TCoolTrayIcon.SetHint(Value: string);
begin
FHint := Value;
ModifyIcon;
end;
procedure TCoolTrayIcon.SetShowHint(Value: Boolean);
begin
FShowHint := Value;
ModifyIcon;
end;
type
TNotifyIconData = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array [0..63] of AnsiChar;
end;定义函数，函数名随便，处理鼠标点到托盘图标后处理事件
procedure IconTray(var Msg:TMessage); Message WM_command;procedure Tmemform.IconTray(var Msg:Tmessage);
var
pt:TPoint;
begin
if Msg.LParam=wm_rbuttondown then //鼠标右键
begin
GetCursorPos(pt);
SetForeGroundWindow(Handle);
PopupMenu1.Popup(pt.x,pt.y);
end;
if Msg.LParam=wm_lbuttondblclk then //鼠标左键
begin
showwindow(Handle,sw_ShowNormal);
setforegroundwindow(Handle);
show;
end;
end;
窗口创建函数中加 nid.cbSize:=sizeof(nid);
nid.Wnd:=Handle;
nid.uID:=1;
nid.uCallbackMessage:=wm_command;
nid.hIcon:=Icon.Handle;
nid.szTip:='鼠标移到托盘图标上显示的提示文本';
nid.uFlags:=nif_message or
nif_Icon or nif_Tip;
Shell_NotifyIcon(NIM_Add,@nid);关闭程序释放托盘图标
procedure Tmemform.FormDestroy(Sender: TObject);
begin
nid.uFlags:=0;
Shell_NotifyIcon(NIM_DELETE,@nid);
end;差不多就ok了
但其實, boby(feuer) 已經給出很簡單的實現了, 你想再簡單, 就用控件了!!!
nid.hIcon:=Application.Icon.Handle;
nid.uFlags:=nif_Icon or nif_Tip;
Shell_NotifyIcon(NIM_MODIFY,@nid);为什么不愿意动手写点代码，老想要现成的，这样不会提高的