unit TrayIcon;interfaceuses Windows, SysUtils, Messages, ShellAPI, Classes, Graphics, Forms, Menus,
  StdCtrls, ExtCtrls;type
  ENotifyIconError = class(Exception);  TTrayNotifyIcon = class(TComponent)
  private
    FDefaultIcon: THandle;
    FIcon: TIcon;
    FHideTask: Boolean;
    FHint: string;
    FIconVisible: Boolean;
    FPopupMenu: TPopupMenu;
    FOnClick: TNotifyEvent;
    FOnDblClick: TNotifyEvent;
    FNoShowClick: Boolean;
    FTimer: TTimer;
    Tnd: TNotifyIconData;
    procedure SetIcon(Value: TIcon);
    procedure SetHideTask(Value: Boolean);
    procedure SetHint(Value: string);
    procedure SetIconVisible(Value: Boolean);
    procedure SetPopupMenu(Value: TPopupMenu);
    procedure SendTrayMessage(Msg: DWORD; Flags: UINT);
    function ActiveIconHandle: THandle;
    procedure OnButtonTimer(Sender: TObject);
  protected
    procedure Loaded; override;
    procedure LoadDefaultIcon; virtual;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Icon: TIcon read FIcon write SetIcon;
    property HideTask: Boolean read FHideTask write SetHideTask default False;
    property Hint: String read FHint write SetHint;
    property IconVisible: Boolean read FIconVisible write SetIconVisible default False;
    property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
  end;implementation{ TIconManager }
{ This class creates a hidden window which handles and routes }
{ tray icon messages }
type
  TIconManager = class
  private
    FHWindow: HWnd;
    procedure TrayWndProc(var Message: TMessage);
  public
    constructor Create;
    destructor Destroy; override;
    property HWindow: HWnd read FHWindow write FHWindow;
  end;var
  IconMgr: TIconManager;
  DDGM_TRAYICON: Cardinal;constructor TIconManager.Create;
begin
  FHWindow := AllocateHWnd(TrayWndProc);
end;destructor TIconManager.Destroy;
begin
  if FHWindow <> 0 then DeallocateHWnd(FHWindow);
  inherited Destroy;
end;procedure TIconManager.TrayWndProc(var Message: TMessage);
{ This allows us to handle all tray callback messages }
{ from within the context of the component. }
var
  Pt: TPoint;
  TheIcon: TTrayNotifyIcon;
begin
  with Message do
  begin
    { if it's the tray callback message }
    if (Msg = DDGM_TRAYICON) then
    begin
      TheIcon := TTrayNotifyIcon(WParam);
//u C a l l b a c k M e s s a g e域是发向由W n d域标识的窗口的消息。一般来说,这个域的值可以通过R e g i s t e rWi n d o w M e s s a g e ( )来获得,也可以通过W M _ U S E R的偏移量获得。这个消息的l P a r a m参数与u I D域的值相同,w P a r a m参数是鼠标经过图标上时产生的消息!!!原来的书刚好写反`      case lParam of
        { enable timer on first mouse down. }
        { OnClick will be fired by OnTimer method, provided }
        { double click has not occurred. }
        WM_LBUTTONDOWN: TheIcon.FTimer.Enabled := True;
        { Set no click flag on double click.  This will supress }
        { the single click. }
        WM_LBUTTONDBLCLK:
          begin
            TheIcon.FNoShowClick := True;
            if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(Self);
          end;
        WM_RBUTTONDOWN:
          begin
            if Assigned(TheIcon.FPopupMenu) then
            begin
              { Call to SetForegroundWindow is required by API }
              SetForegroundWindow(IconMgr.HWindow);
              { Popup local menu at the cursor position. }
              GetCursorPos(Pt);
              TheIcon.FPopupMenu.Popup(Pt.X, Pt.Y);
              { Message post required by API to force task switch }
              PostMessage(IconMgr.HWindow, WM_USER, 0, 0);
            end;
          end;
      end;
    end
    else
      { If it isn't a tray callback message, then call DefWindowProc }
      Result := DefWindowProc(FHWindow, Msg, wParam, lParam);
  end;
end;