如何实现系统托盘的动态图标,就像QQ那样实现动态的变换图标 (100分)

各位富翁：
你们好！在下有个问题，希望能得到各位富翁的指点，就是如何实现系统托盘的动态图标,
就像QQ那样实现动态的变换图标，如果启动任务就把A.ico,B.ico,C.ico三个图标，不停的更换
起到一个动画效果，就知道任务在启动，结束后恢复默认图标。如果解决问题，100分
相送！我对delphi还不是很熟悉，希望你们能给出一个完整代码的例子！谢谢你们！

用一个timer换就可以了，要不然找控件abc6.0,raize3.0都有这种功能，www.51delphi.com

很简单，在一定时器里调用API
Shell_NotifyEvent(NIM_CHANGE,
就可以改变图标

NeutronDelphi,pink_wt:
你们好！谢谢你们的解答，我对delphi还不是很熟悉，希望你们能给出一个完整代码的例子！

利用Shell_NotifyIcon api函数可以很容易的实现，
注意还有个NOTIFYICONDATA类型的参数传值哦
MS的msdn里有很完整的例子，不过是c++和vb的，好好看看吧

unit TrayIcon;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Menus,shellapi, ImgList, ExtCtrls;

type
//----------------------------------------------------------------------
PNotifyIconData = ^TNotifyIconDataA;
TNotifyIconDataA = record
cbSize : DWORD;
Wnd : HWND;
uID : UINT;
uFlags : UINT;
uCallbackMessage : UINT;
hIcon : HICON;
szTip : array [0..63] of AnsiChar;
end;
//----------------------------------------------------------------------
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
open1: TMenuItem;
close1: TMenuItem;
N1: TMenuItem;
about1: TMenuItem;
ImageList1: TImageList;
Timer1: TTimer;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure open1Click(Sender: TObject);
procedure close1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
//-------------------------------------------------------------
Icons: array[0..1] of TIcon;
IconData: TNotifyIconData;
procedure ShowIcon;
procedure IconOnClick(var message:TMessage); message WM_USER+1;
Procedure WMSysCommand(Var message : TMessage) ; Message WM_SYSCOMMAND ;
//-------------------------------------------------------------
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.IconOnClick( var message: Tmessage);
var p : TPoint;
begin
if (message.lParam = WM_LBUTTONDOWN) then
begin
ShowWindow(Handle, SW_SHOW );
end;

if (message.lParam = WM_RBUTTONDOWN) then
begin
GetCursorPos(p);
popupmenu1.Popup( p.x ,p.y );
end;
end;

Procedure TForm1.WMSysCommand(Var Message : TMessage) ;
begin

if (Message.WParam = SC_MINIMIZE) then
begin
ShowIcon;
end
else
Inherited;

end;

procedure TForm1.ShowIcon;
begin
IconData.cbSize := SizeOf( IconData );
IconData.Wnd := Handle;
IconData.uID := 1;
IconData.uFlags := NIF_ICON
or NIF_MESSAGE or NIF_TIP;
IconData.uCallBackMessage := WM_USER+1;
IconData.hIcon := Icons[0].Handle;//application.Icon.Handle;
IconData.szTip := 'LANChat';
Shell_NotifyIcon( NIM_ADD, @IconData );
ShowWindow(Handle, SW_HIDE);
hide;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Shell_NotifyIcon( NIM_DELETE, @IconData );
end;

procedure TForm1.open1Click(Sender: TObject);
begin
Form1.Show;
end;

procedure TForm1.close1Click(Sender: TObject);
begin
Form1.close;
end;

procedure TForm1.FormShow(Sender: TObject);
begin

showwindow(application.handle,sw_hide);

end;

procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
begin
for i:=0 to 1 do
begin
Icons := TIcon.Create;
ImageList1.GetIcon(i,Icons); //ImageList1中放了两个icon
end;
showicon;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if IconData.hIcon = Icons[0].Handle then IconData.hIcon := Icons[1].Handle
else IconData.hIcon := Icons[0].Handle;
Shell_NotifyIcon( NIM_MODIFY, @IconData );
end;

end.

發EMAIL給我吧，我給你一個我自已寫的控件，帶源碼的。
zhangleiha@163.net

[8D]

{*****************************************************************}
{ 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 - delphiuser@get2net.dk }
{ Copyright (c) 2002 }
{ }
{ Portions by Jouni Airaksinen - mintus@codefield.com }
{*****************************************************************}

unit CoolTrayIcon;

{$T-} // Use untyped pointers as we override TNotifyIconData with TNotifyIconDataEx

{ Some methods have moved to the Classes unit in D6 and are thus deprecated.
Using the following compiler directives we handle that situation. }
{$IFDEF VER140} {$DEFINE DELPHI_6} {$ENDIF}
{$IFDEF VER150} {$DEFINE DELPHI_7} {$ENDIF}
{$IFDEF DELPHI_6} {$DEFINE DELPHI_6_UP} {$ENDIF}
{$IFDEF DELPHI_7} {$DEFINE DELPHI_6_UP} {$ENDIF}

{ The TCustomImageList class only exists from D4, so we need special handling
for D2 and D3. We define another compiler directive for this. }
{$DEFINE DELPHI_4_UP}
{$IFDEF VER100} {$UNDEF DELPHI_4_UP} {$ENDIF}
{$IFDEF VER110} {$UNDEF DELPHI_4_UP} {$ENDIF}

{ I tried to hack around the problem that in some versions of NT4 the tray icon
will not display properly upon logging off, then logging on. It appears to be
a VCL problem. The solution is probably to substitute Delphi's AllocateHWnd
method, but I haven't gotten around to experimenting with that.
For now, leave WINNT_SERVICE_HACK undefined (no special NT handling). }
{$UNDEF WINNT_SERVICE_HACK}

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Menus, ShellApi, ExtCtrls, SimpleTimer {$IFDEF DELPHI_4_UP}, ImgList{$ENDIF};

const
// User-defined message sent by the trayicon
WM_TRAYNOTIFY = WM_USER + 1024;

type
TTimeoutOrVersion = record
case Integer of // 0: Before Win2000; 1: Win2000 and up
0: (uTimeout: UINT);
1: (uVersion: UINT); // Only used when sending a NIM_SETVERSION message
end;

{ You can use the TNotifyIconData record structure defined in shellapi.pas.
However, WinME, Win2000, and WinXP have expanded this structure, so in
order to implement their new features we define a similar structure,
TNotifyIconDataEx. }
{ The old TNotifyIconData record contains a field called Wnd in Delphi
and hWnd in C++ Builder. The compiler directive DFS_CPPB_3_UP was used
to distinguish between the two situations, but is no longer necessary
when we define our own record, TNotifyIconDataEx. }
TNotifyIconDataEx = record
cbSize: DWORD;
hWnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array[0..127] of AnsiChar; // Previously 64 chars, now 128
dwState: DWORD;
dwStateMask: DWORD;
szInfo: array[0..255] of AnsiChar;
TimeoutOrVersion: TTimeoutOrVersion;
szInfoTitle: array[0..63] of AnsiChar;
dwInfoFlags: DWORD;
{$IFDEF _WIN32_IE_600}
guidItem: TGUID; // Reserved for WinXP; define _WIN32_IE_600 if needed
{$ENDIF}
end;

TBalloonHintIcon = (bitNone, bitInfo, bitWarning, bitError);
TBalloonHintTimeOut = 10..60; // Windows defines 10-60 secs. as min-max
TBehavior = (bhWin95, bhWin2000);
THintString = AnsiString; // 128 bytes, last char should be #0

TCycleEvent = procedure(Sender: TObject; NextIndex: Integer) of object;
TStartupEvent = procedure(Sender: TObject; var ShowMainForm: Boolean) of object;

TCoolTrayIcon = class(TComponent)
private
FEnabled: Boolean;
FIcon: TIcon;
FIconID: Cardinal;
FIconVisible: Boolean;
FHint: THintString;
FShowHint: Boolean;
FPopupMenu: TPopupMenu;
FLeftPopup: Boolean;
FOnClick,
FOnDblClick: TNotifyEvent;
FOnCycle: TCycleEvent;
FOnStartup: TStartupEvent;
FOnMouseDown,
FOnMouseUp: TMouseEvent;
FOnMouseMove: TMouseMoveEvent;
FOnMouseEnter: TNotifyEvent;
FOnMouseExit: TNotifyEvent;
FOnMinimizeToTray: TNotifyEvent;
FOnBalloonHintShow,
FOnBalloonHintHide,
FOnBalloonHintTimeout,
FOnBalloonHintClick: TNotifyEvent;
FMinimizeToTray: Boolean;
FClickStart: Boolean;
FClickReady: Boolean;
CycleTimer: TSimpleTimer; // For icon cycling
ClickTimer: TSimpleTimer; // For distinguishing click and dbl.click
ExitTimer: TSimpleTimer; // For OnMouseExit event
LastMoveX, LastMoveY: Integer;
FDidExit: Boolean;
FWantEnterExitEvents: Boolean;
FBehavior: TBehavior;
IsDblClick: Boolean;
FIconIndex: Integer; // Current index in imagelist
FDesignPreview: Boolean;
SettingPreview: Boolean; // Internal status flag
SettingMDIForm: Boolean; // Internal status flag
{$IFDEF DELPHI_4_UP}
FIconList: TCustomImageList;
{$ELSE}
FIconList: TImageList;
{$ENDIF}
FCycleIcons: Boolean;
FCycleInterval: Cardinal;
// OldAppProc, NewAppProc: Pointer; // Procedure variables
OldWndProc, NewWndProc: Pointer; // Procedure variables
procedure SetDesignPreview(Value: Boolean);
procedure SetCycleIcons(Value: Boolean);
procedure SetCycleInterval(Value: Cardinal);
function InitIcon: Boolean;
procedure SetIcon(Value: TIcon);
procedure SetIconVisible(Value: Boolean);
{$IFDEF DELPHI_4_UP}
procedure SetIconList(Value: TCustomImageList);
{$ELSE}
procedure SetIconList(Value: TImageList);
{$ENDIF}
procedure SetIconIndex(Value: Integer);
procedure SetHint(Value: THintString);
procedure SetShowHint(Value: Boolean);
procedure SetWantEnterExitEvents(Value: Boolean);
procedure SetBehavior(Value: TBehavior);
procedure IconChanged(Sender: TObject);
{$IFDEF WINNT_SERVICE_HACK}
function IsWinNT: Boolean;
{$ENDIF}
// Hook methods
function HookAppProc(var Msg: TMessage): Boolean;
procedure HookForm;
procedure UnhookForm;
procedure HookFormProc(var Msg: TMessage);
// SimpleTimer event methods
procedure ClickTimerProc(Sender: TObject);
procedure CycleTimerProc(Sender: TObject);
procedure MouseExitTimerProc(Sender: TObject);
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 MouseEnter; dynamic;
procedure MouseExit; dynamic;
procedure DoMinimizeToTray; dynamic;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
property Handle: HWND read IconData.hWnd;
property Behavior: TBehavior read FBehavior write SetBehavior default bhWin95;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Refresh: Boolean;
function ShowBalloonHint(Title: String; Text: String; IconType: TBalloonHintIcon;
TimeoutSecs: TBalloonHintTimeOut): Boolean;
function HideBalloonHint: Boolean;
procedure PopupAtCursor;
function BitmapToIcon(const Bitmap: TBitmap; const Icon: TIcon;
MaskColor: TColor): Boolean;
function GetClientIconPos(X, Y: Integer): TPoint;
function GetTooltipHandle: HWND;
function GetBalloonHintHandle: HWND;
//----- SPECIAL: methods that only apply when owner is a form -----
procedure HideTaskbarIcon;
procedure ShowTaskbarIcon;
procedure ShowMainForm;
procedure HideMainForm;
//----- END SPECIAL -----
published
// Properties:
property DesignPreview: Boolean read FDesignPreview write SetDesignPreview
default False;
{$IFDEF DELPHI_4_UP}
property IconList: TCustomImageList read FIconList write SetIconList;
{$ELSE}
property IconList: TImageList read FIconList write SetIconList;
{$ENDIF}
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: THintString read FHint write SetHint;
property ShowHint: Boolean read FShowHint write SetShowHint default True;
property Icon: TIcon read FIcon write SetIcon;
property IconVisible: Boolean read FIconVisible write SetIconVisible
default False;
property IconIndex: Integer read FIconIndex write SetIconIndex;
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
property LeftPopup: Boolean read FLeftPopup write FLeftPopup default False;
property WantEnterExitEvents: Boolean read FWantEnterExitEvents
write SetWantEnterExitEvents default False;
//----- SPECIAL: properties that only apply when owner is a form -----
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 OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseExit: TNotifyEvent read FOnMouseExit write FOnMouseExit;
property OnCycle: TCycleEvent read FOnCycle write FOnCycle;
property OnBalloonHintShow: TNotifyEvent read FOnBalloonHintShow
write FOnBalloonHintShow;
property OnBalloonHintHide: TNotifyEvent read FOnBalloonHintHide
write FOnBalloonHintHide;
property OnBalloonHintTimeout: TNotifyEvent read FOnBalloonHintTimeout
write FOnBalloonHintTimeout;
property OnBalloonHintClick: TNotifyEvent read FOnBalloonHintClick
write FOnBalloonHintClick;
//----- SPECIAL: events that only apply when owner is a form -----
property OnMinimizeToTray: TNotifyEvent read FOnMinimizeToTray
write FOnMinimizeToTray;
property OnStartup: TStartupEvent read FOnStartup write FOnStartup;
//----- END SPECIAL -----
end;


implementation

{$IFDEF DELPHI_4_UP}
uses
ComCtrls;
{$ENDIF}

const
// Key select events (Space and Enter)
NIN_SELECT = WM_USER + 0;
NINF_KEY = 1;
NIN_KEYSELECT = NINF_KEY or NIN_SELECT;
// Events returned by balloon hint
NIN_BALLOONSHOW = WM_USER + 2;
NIN_BALLOONHIDE = WM_USER + 3;
NIN_BALLOONTIMEOUT = WM_USER + 4;
NIN_BALLOONUSERCLICK = WM_USER + 5;
// Constants used for balloon hint feature
NIIF_NONE = $00000000;
NIIF_INFO = $00000001;
NIIF_WARNING = $00000002;
NIIF_ERROR = $00000003;
NIIF_ICON_MASK = $0000000F; // Reserved for WinXP
NIIF_NOSOUND = $00000010; // Reserved for WinXP
// Additional uFlags constants for TNotifyIconDataEx
NIF_STATE = $00000008;
NIF_INFO = $00000010;
NIF_GUID = $00000020;
// Additional dwMessage constants for Shell_NotifyIcon
NIM_SETFOCUS = $00000003;
NIM_SETVERSION = $00000004;
NOTIFYICON_VERSION = 3; // Used with the NIM_SETVERSION message
// Tooltip constants
TOOLTIPS_CLASS = 'tooltips_class32';
TTS_NOPREFIX = 2;

type
TTrayIconHandler = class(TObject)
private
RefCount: Cardinal;
FHandle: HWND;
public
constructor Create;
destructor Destroy; override;
procedure Add;
procedure Remove;
procedure HandleIconMessage(var Msg: TMessage);
end;

var
TrayIconHandler: TTrayIconHandler = nil;
{$IFDEF WINNT_SERVICE_HACK}
WinNT: Boolean = False; // For Win NT
HComCtl32: Cardinal = $7FFFFFFF; // For Win NT
{$ENDIF}
WM_TASKBARCREATED: Cardinal;
SHELL_VERSION: Integer;

{------------------ TTrayIconHandler ------------------}

constructor TTrayIconHandler.Create;
begin
inherited Create;
RefCount := 0;
{$IFDEF DELPHI_6_UP}
FHandle := Classes.AllocateHWnd(HandleIconMessage);
{$ELSE}
FHandle := AllocateHWnd(HandleIconMessage);
{$ENDIF}
end;


destructor TTrayIconHandler.Destroy;
begin
{$IFDEF DELPHI_6_UP}
Classes.DeallocateHWnd(FHandle); // Free the tray window
{$ELSE}
DeallocateHWnd(FHandle); // Free the tray window
{$ENDIF}
inherited Destroy;
end;


procedure TTrayIconHandler.Add;
begin
Inc(RefCount);
end;


procedure TTrayIconHandler.Remove;
begin
if RefCount > 0 then
Dec(RefCount);
end;


{ HandleIconMessage handles messages that go to the shell notification
window (tray icon) itself. Most messages are passed through WM_TRAYNOTIFY.
In these cases we use lParam to get the actual message, eg. WM_MOUSEMOVE.
The method fires the appropriate event methods like OnClick and OnMouseMove. }

{ The message always goes through the container, TrayIconHandler.
Msg.wParam contains the ID of the TCoolTrayIcon instance, which we stored
as the object pointer Self in the TCoolTrayIcon constructor. We therefore
cast wParam to a TCoolTrayIcon instance. }

procedure TTrayIconHandler.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;
{$IFDEF WINNT_SERVICE_HACK}
InitComCtl32: procedure;
{$ENDIF}
begin
if Msg.Msg = WM_TRAYNOTIFY then
// Take action if a message from the tray icon comes through
begin
{$WARNINGS OFF}
with TCoolTrayIcon(Msg.wParam) do // Cast to a TCoolTrayIcon instance
{$WARNINGS ON}
begin
case Msg.lParam of

WM_MOUSEMOVE:
if FEnabled then
begin
// MouseEnter event
if FWantEnterExitEvents then
if FDidExit then
begin
MouseEnter;
FDidExit := False;
end;
// MouseMove event
Shift := ShiftState;
GetCursorPos(Pt);
MouseMove(Shift, Pt.x, Pt.y);
LastMoveX := Pt.x;
LastMoveY := Pt.y;
end;

WM_LBUTTONDOWN:
if FEnabled then
begin
{ If we have no OnDblClick event fire the Click event immediately.
Otherwise start a timer and wait for a short while to see if user
clicks again. If he does click again inside this period we have
a double click in stead of a click. }
if Assigned(FOnDblClick) then
begin
ClickTimer.Interval := GetDoubleClickTime;
ClickTimer.Enabled := True;
end;
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
FClickReady := True;

if FClickStart and (not ClickTimer.Enabled) then
begin
{ At this point we know a mousedown occured, and the dblclick timer
timed out. We have a delayed click. }
FClickStart := False;
FClickReady := False;
Click; // We have a click
end;

FClickStart := False;

MouseUp(mbLeft, Shift, Pt.x, Pt.y);
end;

WM_RBUTTONUP:
if FBehavior = bhWin95 then
if FEnabled then
begin
Shift := ShiftState + [ssRight];
GetCursorPos(Pt);
MouseUp(mbRight, Shift, Pt.x, Pt.y);
end;

WM_CONTEXTMENU, NIN_SELECT, NIN_KEYSELECT:
if FBehavior = bhWin2000 then
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
FClickReady := False;
IsDblClick := True;
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.Default then
M := PopupMenu.Items;
end;
if M <> nil then
M.Click;
end;

NIN_BALLOONSHOW: begin
if Assigned(FOnBalloonHintShow) then
FOnBalloonHintShow(Self);
end;

NIN_BALLOONHIDE:
if Assigned(FOnBalloonHintHide) then
FOnBalloonHintHide(Self);

NIN_BALLOONTIMEOUT:
if Assigned(FOnBalloonHintTimeout) then
FOnBalloonHintTimeout(Self);

NIN_BALLOONUSERCLICK:
if Assigned(FOnBalloonHintClick) then
FOnBalloonHintClick(Self);

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. The same goes for other specific system messages. }
WM_CLOSE, WM_QUIT, WM_DESTROY, WM_NCDESTROY: begin
Msg.Result := 1;
end;
{
WM_DESTROY:
if not (csDesigning in ComponentState) then
begin
Msg.Result := 0;
PostQuitMessage(0);
end;
}
WM_QUERYENDSESSION, WM_ENDSESSION: begin
Msg.Result := 1;
end;

{$IFDEF WINNT_SERVICE_HACK}
WM_USERCHANGED:
if WinNT then begin
// Special handling for Win NT: Load/unload common controls library
if HComCtl32 = 0 then
begin
// Load and initialize common controls library
HComCtl32 := LoadLibrary('comctl32.dll');
{ We load the entire dll. This is probably unnecessary.
The InitCommonControlsEx method may be more appropriate. }
InitComCtl32 := GetProcAddress(HComCtl32, 'InitCommonControls');
InitComCtl32;
end
else
begin
// Unload common controls library (if it is loaded)
if HComCtl32 <> $7FFFFFFF then
FreeLibrary(HComCtl32);
HComCtl32 := 0;
end;
Msg.Result := 1;
end;
{$ENDIF}

else // Handle all other messages with the default handler
Msg.Result := DefWindowProc(FHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;
end;

{---------------- Container management ----------------}

procedure AddTrayIcon;
begin
if not Assigned(TrayIconHandler) then
// Create new handler
TrayIconHandler := TTrayIconHandler.Create;
TrayIconHandler.Add;
end;


procedure RemoveTrayIcon;
begin
if Assigned(TrayIconHandler) then
begin
TrayIconHandler.Remove;
if TrayIconHandler.RefCount = 0 then
begin
// Destroy handler
TrayIconHandler.Free;
TrayIconHandler := nil;
end;
end;
end;

{------------- SimpleTimer event methods --------------}

procedure TCoolTrayIcon.ClickTimerProc(Sender: TObject);
begin
ClickTimer.Enabled := False;
if (not IsDblClick) then
if FClickReady then
begin
FClickReady := False;
Click;
end;
IsDblClick := False;
end;


procedure TCoolTrayIcon.CycleTimerProc(Sender: TObject);
begin
if Assigned(FIconList) then
begin
FIconList.GetIcon(FIconIndex, FIcon);
// IconChanged(AOwner);
CycleIcon; // Call event method

if FIconIndex < FIconList.Count-1 then
SetIconIndex(FIconIndex+1)
else
SetIconIndex(0);
end;
end;


procedure TCoolTrayIcon.MouseExitTimerProc(Sender: TObject);
var
Pt: TPoint;
begin
if FDidExit then
Exit;
GetCursorPos(Pt);
if (Pt.x < LastMoveX) or (Pt.y < LastMoveY) or
(Pt.x > LastMoveX) or (Pt.y > LastMoveY) then
begin
FDidExit := True;
MouseExit;
end;
end;

{------------------- TCoolTrayIcon --------------------}

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

AddTrayIcon; // Container management
{$WARNINGS OFF}
FIconID := Cardinal(Self); // Use Self object pointer as ID
{$WARNINGS ON}

SettingMDIForm := True;
FEnabled := True; // Enabled by default
FShowHint := True; // Show hint by default
SettingPreview := False;

FIcon := TIcon.Create;
FIcon.OnChange := IconChanged;
FillChar(IconData, SizeOf(IconData), 0);
IconData.cbSize := SizeOf(TNotifyIconDataEx);
{ IconData.hWnd points to procedure to receive callback messages from the icon.
We set it to our TrayIconHandler instance. }
IconData.hWnd := TrayIconHandler.FHandle;
// Add an id for the tray icon
IconData.uId := FIconID;
// We want icon, message handling, and tooltips by default
IconData.uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
// Message to send to IconData.hWnd when event occurs
IconData.uCallbackMessage := WM_TRAYNOTIFY;

// Create SimpleTimers for later use
CycleTimer := TSimpleTimer.Create;
CycleTimer.OnTimer := CycleTimerProc;
ClickTimer := TSimpleTimer.Create;
ClickTimer.OnTimer := ClickTimerProc;
ExitTimer := TSimpleTimer.CreateEx(20, MouseExitTimerProc);

FDidExit := True; // Prevents MouseExit from firing at startup

SetDesignPreview(FDesignPreview);

// Set hook(s)
if not (csDesigning in ComponentState) then
begin
{ 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 HookAppProc).
You can then catch any message that goes through the app. and still use
the OnMinimize event. }
Application.HookMainWindow(HookAppProc);
{ You can hook into the main form (or any other window), 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. }
if Owner is TWinControl then
HookForm;
end;
end;


destructor TCoolTrayIcon.Destroy;
begin
try
SetIconVisible(False); // Remove the icon from the tray
SetDesignPreview(False); // Remove any DesignPreview icon
CycleTimer.Free;
ClickTimer.Free;
ExitTimer.Free;
try
if FIcon <> nil then
FIcon.Free;
except
on Exception do
// Do nothing; the icon seems to be invalid
end;
finally
// It is important to unhook any hooked processes
if not (csDesigning in ComponentState) then
begin
Application.UnhookMainWindow(HookAppProc);
if Owner is TWinControl then
UnhookForm;
end;
RemoveTrayIcon; // Container management
inherited Destroy;
end
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).
Other boolean values must also be set here. }
var
Show: Boolean;
begin
inherited Loaded; // Always call inherited Loaded first

if Owner is TWinControl then
if not (csDesigning in ComponentState) then
begin
Show := True;
if Assigned(FOnStartup) then
FOnStartup(Self, Show);
if not Show then
begin
Application.ShowMainForm := False;
HideMainForm;
end;
end;

ModifyIcon;
SetIconVisible(FIconVisible);
SetCycleIcons(FCycleIcons);
SetWantEnterExitEvents(FWantEnterExitEvents);
SetBehavior(FBehavior);
{$IFDEF WINNT_SERVICE_HACK}
WinNT := IsWinNT;
{$ENDIF}
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;


procedure TCoolTrayIcon.IconChanged(Sender: TObject);
begin
ModifyIcon;
end;


{ All app. messages pass through HookAppProc. You can override the messages
by not passing them along to Windows (set Result=True). }

function TCoolTrayIcon.HookAppProc(var Msg: TMessage): Boolean;
var
Show: Boolean;
// HideForm: Boolean;
begin
Result := False; // Should always be False unless we don't want the default message handling

case Msg.Msg of

WM_SIZE:
// Handle MinimizeToTray by capturing minimize event of application
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 the app. to be redisplayed on the
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
begin
Show := True;
if Assigned(FOnStartup) then
FOnStartup(Self, Show);
if not Show then
HideTaskbarIcon;
end;

SettingMDIForm := False; // So we only do this once
end;
end;

WM_SYSCOMMAND:
// Handle MinimizeToTray by capturing minimize event of application
if Msg.wParam = SC_RESTORE then
Application.MainForm.Visible := True;

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;
end;


procedure TCoolTrayIcon.HookForm;
begin
if (Owner as TWinControl) <> nil then
begin
// Hook the parent window
OldWndProc := Pointer(GetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC));
{$IFDEF DELPHI_6_UP}
NewWndProc := Classes.MakeObjectInstance(HookFormProc);
{$ELSE}
NewWndProc := MakeObjectInstance(HookFormProc);
{$ENDIF}
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
{$IFDEF DELPHI_6_UP}
Classes.FreeObjectInstance(NewWndProc);
{$ELSE}
FreeObjectInstance(NewWndProc);
{$ENDIF}
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);

function DoMinimizeEvents: Boolean;
begin
Result := False;
if FMinimizeToTray then
if Assigned(FOnMinimizeToTray) then
begin
FOnMinimizeToTray(Self);
DoMinimizeToTray;
Msg.Result := 1;
Result := True;
end;
end;

begin
case Msg.Msg of

WM_SHOWWINDOW: begin
if (Msg.wParam = 1) and (Msg.lParam = 0) 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

else if (Msg.wParam = 0) and (Msg.lParam = SW_PARENTCLOSING) then
begin
// Application is minimizing (or closing), handle MinimizeToTray
if not Application.Terminated then
if DoMinimizeEvents then
Exit; // Don't pass the message on
end;

end;

WM_SYSCOMMAND:
// Handle MinimizeToTray by capturing minimize event of form
if Msg.wParam = SC_MINIMIZE then
if DoMinimizeEvents then
Exit; // Don't pass the message on

WM_DESTROY, WM_NCDESTROY: begin
Msg.Result := 1;
Exit;
end;

end;
{
case Msg.Msg of
WM_QUERYENDSESSION: begin
Msg.Result := 1;
end;
else
}
// Pass the message on
Msg.Result := CallWindowProc(OldWndProc, (Owner as TWinControl).Handle,
Msg.Msg, Msg.wParam, Msg.lParam);
{
end;
}
end;


procedure TCoolTrayIcon.SetIcon(Value: TIcon);
begin
FIcon.OnChange := nil;
// FIcon := Value;
FIcon.Assign(Value);
FIcon.OnChange := IconChanged;
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
{ 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
begin
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);
Seems to work, but I don't recommend it. Why would you want to, anyway? }
SetIconVisible(Value);
end;
SettingPreview := False; // Clear flag
end;


procedure TCoolTrayIcon.SetCycleIcons(Value: Boolean);
begin
FCycleIcons := Value;
if Value then
SetIconIndex(0);
if Value then
begin
CycleTimer.Interval := FCycleInterval;
CycleTimer.Enabled := True;
end
else
CycleTimer.Enabled := False;
end;


procedure TCoolTrayIcon.SetCycleInterval(Value: Cardinal);
begin
FCycleInterval := Value;
SetCycleIcons(FCycleIcons);
end;


{$IFDEF DELPHI_4_UP}
procedure TCoolTrayIcon.SetIconList(Value: TCustomImageList);
{$ELSE}
procedure TCoolTrayIcon.SetIconList(Value: TImageList);
{$ENDIF}
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: THintString);
begin
FHint := Value;
ModifyIcon;
end;


procedure TCoolTrayIcon.SetShowHint(Value: Boolean);
begin
FShowHint := Value;
ModifyIcon;
end;


procedure TCoolTrayIcon.SetWantEnterExitEvents(Value: Boolean);
begin
FWantEnterExitEvents := Value;
ExitTimer.Enabled := Value;
end;


procedure TCoolTrayIcon.SetBehavior(Value: TBehavior);
begin
FBehavior := Value;
case FBehavior of
bhWin95: IconData.TimeoutOrVersion.uVersion := 0;
bhWin2000: IconData.TimeoutOrVersion.uVersion := NOTIFYICON_VERSION;
end;
Shell_NotifyIcon(NIM_SETVERSION, @IconData);
end;


function TCoolTrayIcon.InitIcon: Boolean;
// Set icon and tooltip
var
ok: Boolean;
begin
Result := False;
ok := True;
if (csDesigning in ComponentState) then
ok := (SettingPreview or FDesignPreview);

if ok then
begin
try
IconData.hIcon := FIcon.Handle;
except
on EReadError do // Seems the icon was destroyed
begin
IconData.hIcon := 0;
// Exit;
end;
end;
if (FHint <> '') and (FShowHint) then
begin
StrLCopy(IconData.szTip, PChar(String(FHint)), SizeOf(IconData.szTip)-1);
{ StrLCopy must be used since szTip is only 128 bytes. }
{ In IE ver. 5 szTip is 128 chars, before that only 64 chars. I suppose
I could use GetComCtlVersion to check the version and then truncate
the string accordingly, but Windows seems to handle this ok by itself. }
IconData.szTip[SizeOf(IconData.szTip)-1] := #0;
end
else
IconData.szTip := '';
Result := True;
end;
end;


function TCoolTrayIcon.ShowIcon: Boolean;
// Add/show the icon on the tray
begin
Result := False;
if not SettingPreview then
FIconVisible := True;
begin
if (csDesigning in ComponentState) then
begin
if SettingPreview then
if InitIcon then
Result := Shell_NotifyIcon(NIM_ADD, @IconData);
end
else
if InitIcon then
Result := Shell_NotifyIcon(NIM_ADD, @IconData);
end;
end;


function TCoolTrayIcon.HideIcon: Boolean;
// Remove/hide the icon from the tray
begin
Result := False;
if not SettingPreview then
FIconVisible := False;
begin
if (csDesigning in ComponentState) then
begin
if SettingPreview then
if InitIcon then
Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
end
else
if InitIcon then
Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
end;
end;


function TCoolTrayIcon.ModifyIcon: Boolean;
// Change icon or tooltip if icon already placed
begin
Result := False;
if InitIcon then
Result := Shell_NotifyIcon(NIM_MODIFY, @IconData);
end;


function TCoolTrayIcon.ShowBalloonHint(Title: String; Text: String;
IconType: TBalloonHintIcon; TimeoutSecs: TBalloonHintTimeOut): Boolean;
// Show balloon hint. Return false if error.
const
aBalloonIconTypes: array[TBalloonHintIcon] of Byte =
(NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR);
begin
// Remove old balloon hint
HideBalloonHint;
// Display new balloon hint
with IconData do
begin
uFlags := uFlags or NIF_INFO;
StrLCopy(szInfo, PChar(Text), SizeOf(szInfo)-1);
StrLCopy(szInfoTitle, PChar(Title), SizeOf(szInfoTitle)-1);
TimeoutOrVersion.uTimeout := TimeoutSecs * 1000;
dwInfoFlags := aBalloonIconTypes[IconType];
end;
Result := ModifyIcon;
{ Remove NIF_INFO before next call to ModifyIcon (or the balloon hint will
redisplay itself) }
with IconData do
uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
end;


function TCoolTrayIcon.HideBalloonHint: Boolean;
// Hide balloon hint. Return false if error.
begin
with IconData do
begin
uFlags := uFlags or NIF_INFO;
StrPCopy(szInfo, '');
end;
Result := ModifyIcon;
end;


function TCoolTrayIcon.BitmapToIcon(const Bitmap: TBitmap;
const Icon: TIcon; MaskColor: TColor): Boolean;
{ Render an icon from a 16x16 bitmap. Return false if error.
MaskColor is a color that will be rendered transparently. Use clNone for
no transparency. }
var
BitmapImageList: TImageList;
begin
BitmapImageList := TImageList.CreateSize(16, 16);
try
Result := False;
BitmapImageList.AddMasked(Bitmap, MaskColor);
BitmapImageList.GetIcon(0, Icon);
Result := True;
finally
BitmapImageList.Free;
end;
end;


function TCoolTrayIcon.GetClientIconPos(X, Y: Integer): TPoint;
// Return the cursor position inside the tray icon
const
IconBorder = 1;
// IconSize = 16;
var
H: HWND;
P: TPoint;
IconSize: Integer;
begin
{ The CoolTrayIcon.Handle property is not the window handle of the tray icon.
We can find the window handle via WindowFromPoint when the mouse is over
the tray icon. (It can probably be found via GetWindowLong as well).

BTW: The parent of the tray icon is the TASKBAR - not the traybar, which
contains the tray icons and the clock. The traybar seems to be a canvas,
not a real window (?). }

// Get the icon size
IconSize := GetSystemMetrics(SM_CYCAPTION) - 3;

P.X := X;
P.Y := Y;
H := WindowFromPoint(P);
{ Convert current cursor X,Y coordinates to tray client coordinates.
Add borders to tray icon size in the calculations. }
Windows.ScreenToClient(H, P);
P.X := (P.X mod ((IconBorder*2)+IconSize)) -1;
P.Y := (P.Y mod ((IconBorder*2)+IconSize)) -1;
Result := P;
end;


function TCoolTrayIcon.GetTooltipHandle: HWND;
{ All tray icons (but not the clock) share the same tooltip.
Return the tooltip handle or 0 if error. }
var
wnd, lTaskBar: HWND;
pidTaskBar, pidWnd: DWORD;
begin
// Get the TaskBar handle
lTaskBar := FindWindowEx(0, 0, 'Shell_TrayWnd', nil);
// Get the TaskBar Process ID
GetWindowThreadProcessId(lTaskBar, @pidTaskBar);

// Enumerate all tooltip windows
wnd := FindWindowEx(0, 0, TOOLTIPS_CLASS, nil);
while wnd <> 0 do
begin
// Get the tooltip process ID
GetWindowThreadProcessId(wnd, @pidWnd);
{ Compare the process ID of the taskbar and the tooltip.
If they are the same we have one of the taskbar tooltips. }
if pidTaskBar = pidWnd then
{ Get the tooltip style. The tooltip for tray icons does not have the
TTS_NOPREFIX style. }
if (GetWindowLong(wnd, GWL_STYLE) and TTS_NOPREFIX) = 0 then
Break;

wnd := FindWindowEx(0, wnd, TOOLTIPS_CLASS, nil);
end;
Result := wnd;
end;


function TCoolTrayIcon.GetBalloonHintHandle: HWND;
{ All applications share the same balloon hint.
Return the balloon hint handle or 0 if error. }
var
wnd, lTaskBar: HWND;
pidTaskBar, pidWnd: DWORD;
begin
// Get the TaskBar handle
lTaskBar := FindWindowEx(0, 0, 'Shell_TrayWnd', nil);
// Get the TaskBar Process ID
GetWindowThreadProcessId(lTaskBar, @pidTaskBar);

// Enumerate all tooltip windows
wnd := FindWindowEx(0, 0, TOOLTIPS_CLASS, nil);
while wnd <> 0 do
begin
// Get the tooltip process ID
GetWindowThreadProcessId(wnd, @pidWnd);
{ Compare the process ID of the taskbar and the tooltip.
If they are the same we have one of the taskbar tooltips. }
if pidTaskBar = pidWnd then
// We don't want windows with the TTS_NOPREFIX style. That's the simple tooltip.
if (GetWindowLong(wnd, GWL_STYLE) and TTS_NOPREFIX) <> 0 then
Break;

wnd := FindWindowEx(0, wnd, TOOLTIPS_CLASS, nil);
end;
Result := wnd;
end;


function TCoolTrayIcon.Refresh: Boolean;
// Refresh the icon
begin
Result := ModifyIcon;
end;


procedure TCoolTrayIcon.PopupAtCursor;
var
CursorPos: TPoint;
begin
if Assigned(PopupMenu) then
if PopupMenu.AutoPopup then
if GetCursorPos(CursorPos) then
begin
// Bring the main form (or its modal dialog) to the foreground
SetForegroundWindow(Application.Handle);
{ Win98 (unlike other Windows versions) empties a popup menu before
closing it. This is a problem when the menu is about to display
while it already is active (two click-events in succession). The
menu will flicker annoyingly. Calling ProcessMessages fixes this. }
Application.ProcessMessages;
// Now make the menu pop up
PopupMenu.PopupComponent := Self;
PopupMenu.Popup(CursorPos.X, CursorPos.Y);
// Remove the popup again in case user deselects it
if Owner is TWinControl then // Owner might be of type TService
// Post an empty message to the owner form so popup menu disappears
PostMessage((Owner as TWinControl).Handle, WM_NULL, 0, 0)
{
else
// Owner is not a form; send the empty message to the app.
PostMessage(Application.Handle, WM_NULL, 0, 0);
}
end;
end;


procedure TCoolTrayIcon.Click;
begin
if Assigned(FOnClick) then
FOnClick(Self);
end;


procedure TCoolTrayIcon.DblClick;
begin
if Assigned(FOnDblClick) then
FOnDblClick(Self);
end;


procedure TCoolTrayIcon.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if Assigned(FOnMouseDown) then
FOnMouseDown(Self, Button, Shift, X, Y);
end;


procedure TCoolTrayIcon.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if Assigned(FOnMouseUp) then
FOnMouseUp(Self, Button, Shift, X, Y);
end;


procedure TCoolTrayIcon.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if Assigned(FOnMouseMove) then
FOnMouseMove(Self, Shift, X, Y);
end;


procedure TCoolTrayIcon.MouseEnter;
begin
if Assigned(FOnMouseEnter) then
FOnMouseEnter(Self);
end;


procedure TCoolTrayIcon.MouseExit;
begin
if Assigned(FOnMouseExit) then
FOnMouseExit(Self);
end;


procedure TCoolTrayIcon.CycleIcon;
var
NextIconIndex: Integer;
begin
NextIconIndex := 0;
if FIconList <> nil then
if FIconIndex < FIconList.Count then
NextIconIndex := FIconIndex +1;

if Assigned(FOnCycle) then
FOnCycle(Self, NextIconIndex);
end;


procedure TCoolTrayIcon.DoMinimizeToTray;
begin
// Override this method to change automatic tray minimizing behavior
HideMainForm;
IconVisible := True;
end;


{$IFDEF WINNT_SERVICE_HACK}
function TCoolTrayIcon.IsWinNT: Boolean;
var
ovi: TOSVersionInfo;
rc: Boolean;
begin
rc := False;
ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if GetVersionEx(ovi) then
begin
rc := (ovi.dwPlatformId = VER_PLATFORM_WIN32_NT) and (ovi.dwMajorVersion <= 4);
end;
Result := rc;
end;
{$ENDIF}


procedure TCoolTrayIcon.HideTaskbarIcon;
begin
if IsWindowVisible(Application.Handle) then
ShowWindow(Application.Handle, SW_HIDE);
end;


procedure TCoolTrayIcon.ShowTaskbarIcon;
begin
if not IsWindowVisible(Application.Handle) then
ShowWindow(Application.Handle, SW_SHOW);
end;


procedure TCoolTrayIcon.ShowMainForm;
begin
if Owner is TWinControl then // Owner might be of type TService
if Application.MainForm <> nil then
begin
// Restore the app, but don't automatically show its taskbar icon
// Show application's TASKBAR icon (not the tray icon)
// ShowWindow(Application.Handle, SW_RESTORE);
Application.Restore;
// Show the form itself
if Application.MainForm.WindowState = wsMinimized then
Application.MainForm.WindowState := wsNormal; // Override minimized state
Application.MainForm.Visible := True;
// Bring the main form (or its modal dialog) to the foreground
SetForegroundWindow(Application.Handle);
end;
end;


procedure TCoolTrayIcon.HideMainForm;
begin
if Owner is TWinControl then // Owner might be of type TService
if Application.MainForm <> nil then
begin
// Hide the form itself (and thus any child windows)
Application.MainForm.Visible := False;
{ Hide application's TASKBAR icon (not the tray icon). Do this AFTER
the main form is hidden, or any child windows will redisplay the
taskbar icon if they are visible. }
HideTaskbarIcon;
end;
end;


initialization
{$IFDEF DELPHI_4_UP}
// Get shell version
SHELL_VERSION := GetComCtlVersion;
// Use the TaskbarCreated message available from Win98/IE4+
if SHELL_VERSION >= ComCtlVersionIE4 then
{$ENDIF}
WM_TASKBARCREATED := RegisterWindowMessage('TaskbarCreated');

finalization
if Assigned(TrayIconHandler) then
begin
// Destroy handler
TrayIconHandler.Free;
TrayIconHandler := nil;
end;

end.

在座的各位富翁：
你们好！很高兴能得到你们热情的帮助,再次我非常感谢大家!我参照zw84611富翁给我的
代码去做,成功了!谢谢你zw84611!