CoolTrayIcon.pas
上传用户:hylc_2004
上传日期:2014-01-23
资源大小:46800k
文件大小:47k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. {*****************************************************************}
  2. { This is a component for placing icons in the notification area  }
  3. { of the Windows taskbar (aka. the traybar).                      }
  4. {                                                                 }
  5. { The component is freeware. Feel free to use and improve it.     }
  6. { I would be pleased to hear what you think.                      }
  7. {                                                                 }
  8. { Troels Jakobsen - delphiuser@get2net.dk                         }
  9. { Copyright (c) 2002                                              }
  10. {                                                                 }
  11. { Portions by Jouni Airaksinen - mintus@codefield.com             }
  12. {*****************************************************************}
  13. unit CoolTrayIcon;
  14. {$T-}  // Use untyped pointers as we override TNotifyIconData with TNotifyIconDataEx
  15. { Some methods have moved to the Classes unit in D6 and are thus deprecated.
  16.   Using the following compiler directives we handle that situation. }
  17. {$IFDEF VER140} {$DEFINE DELPHI_6} {$ENDIF}
  18. {$IFDEF VER150} {$DEFINE DELPHI_7} {$ENDIF}
  19. {$IFDEF DELPHI_6} {$DEFINE DELPHI_6_UP} {$ENDIF}
  20. {$IFDEF DELPHI_7} {$DEFINE DELPHI_6_UP} {$ENDIF}
  21. { The TCustomImageList class only exists from D4, so we need special handling
  22.   for D2 and D3. We define another compiler directive for this. }
  23. {$DEFINE DELPHI_4_UP}
  24. {$IFDEF VER100} {$UNDEF DELPHI_4_UP} {$ENDIF}
  25. {$IFDEF VER110} {$UNDEF DELPHI_4_UP} {$ENDIF}
  26. { I tried to hack around the problem that in some versions of NT4 the tray icon
  27.   will not display properly upon logging off, then logging on. It appears to be
  28.   a VCL problem. The solution is probably to substitute Delphi's AllocateHWnd
  29.   method, but I haven't gotten around to experimenting with that.
  30.   For now, leave WINNT_SERVICE_HACK undefined (no special NT handling). }
  31. {$UNDEF WINNT_SERVICE_HACK}
  32. interface
  33. uses
  34.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  35.   Menus, ShellApi, ExtCtrls, SimpleTimer {$IFDEF DELPHI_4_UP}, ImgList{$ENDIF};
  36. const
  37.   // User-defined message sent by the trayicon
  38.   WM_TRAYNOTIFY = WM_USER + 1024;
  39. type
  40.   TTimeoutOrVersion = record
  41.     case Integer of          // 0: Before Win2000; 1: Win2000 and up
  42.       0: (uTimeout: UINT);
  43.       1: (uVersion: UINT);   // Only used when sending a NIM_SETVERSION message
  44.   end;
  45.   { You can use the TNotifyIconData record structure defined in shellapi.pas.
  46.     However, WinME, Win2000, and WinXP have expanded this structure, so in
  47.     order to implement their new features we define a similar structure,
  48.     TNotifyIconDataEx. }
  49.   { The old TNotifyIconData record contains a field called Wnd in Delphi
  50.     and hWnd in C++ Builder. The compiler directive DFS_CPPB_3_UP was used
  51.     to distinguish between the two situations, but is no longer necessary
  52.     when we define our own record, TNotifyIconDataEx. }
  53.   TNotifyIconDataEx = record
  54.     cbSize: DWORD;
  55.     hWnd: HWND;
  56.     uID: UINT;
  57.     uFlags: UINT;
  58.     uCallbackMessage: UINT;
  59.     hIcon: HICON;
  60.     szTip: array[0..127] of AnsiChar;  // Previously 64 chars, now 128
  61.     dwState: DWORD;
  62.     dwStateMask: DWORD;
  63.     szInfo: array[0..255] of AnsiChar;
  64.     TimeoutOrVersion: TTimeoutOrVersion;
  65.     szInfoTitle: array[0..63] of AnsiChar;
  66.     dwInfoFlags: DWORD;
  67. {$IFDEF _WIN32_IE_600}
  68.     guidItem: TGUID;  // Reserved for WinXP; define _WIN32_IE_600 if needed
  69. {$ENDIF}
  70.   end;
  71.   TBalloonHintIcon = (bitNone, bitInfo, bitWarning, bitError);
  72.   TBalloonHintTimeOut = 10..60;   // Windows defines 10-60 secs. as min-max
  73.   TBehavior = (bhWin95, bhWin2000);
  74.   THintString = AnsiString;       // 128 bytes, last char should be #0
  75.   TCycleEvent = procedure(Sender: TObject; NextIndex: Integer) of object;
  76.   TStartupEvent = procedure(Sender: TObject; var ShowMainForm: Boolean) of object;
  77.   TCoolTrayIcon = class(TComponent)
  78.   private
  79.     FEnabled: Boolean;
  80.     FIcon: TIcon;
  81.     FIconID: Cardinal;
  82.     FIconVisible: Boolean;
  83.     FHint: THintString;
  84.     FShowHint: Boolean;
  85.     FPopupMenu: TPopupMenu;
  86.     FLeftPopup: Boolean;
  87.     FOnClick,
  88.     FOnDblClick: TNotifyEvent;
  89.     FOnCycle: TCycleEvent;
  90.     FOnStartup: TStartupEvent;
  91.     FOnMouseDown,
  92.     FOnMouseUp: TMouseEvent;
  93.     FOnMouseMove: TMouseMoveEvent;
  94.     FOnMouseEnter: TNotifyEvent;
  95.     FOnMouseExit: TNotifyEvent;
  96.     FOnMinimizeToTray: TNotifyEvent;
  97.     FOnBalloonHintShow,
  98.     FOnBalloonHintHide,
  99.     FOnBalloonHintTimeout,
  100.     FOnBalloonHintClick: TNotifyEvent;
  101.     FMinimizeToTray: Boolean;
  102.     FClickStart: Boolean;
  103.     FClickReady: Boolean;
  104.     CycleTimer: TSimpleTimer;          // For icon cycling
  105.     ClickTimer: TSimpleTimer;          // For distinguishing click and dbl.click
  106.     ExitTimer: TSimpleTimer;           // For OnMouseExit event
  107.     LastMoveX, LastMoveY: Integer;
  108.     FDidExit: Boolean;
  109.     FWantEnterExitEvents: Boolean;
  110.     FBehavior: TBehavior;
  111.     IsDblClick: Boolean;
  112.     FIconIndex: Integer;               // Current index in imagelist
  113.     FDesignPreview: Boolean;
  114.     SettingPreview: Boolean;           // Internal status flag
  115.     SettingMDIForm: Boolean;           // Internal status flag
  116. {$IFDEF DELPHI_4_UP}
  117.     FIconList: TCustomImageList;
  118. {$ELSE}
  119.     FIconList: TImageList;
  120. {$ENDIF}
  121.     FCycleIcons: Boolean;
  122.     FCycleInterval: Cardinal;
  123. //    OldAppProc, NewAppProc: Pointer;   // Procedure variables
  124.     OldWndProc, NewWndProc: Pointer;   // Procedure variables
  125.     procedure SetDesignPreview(Value: Boolean);
  126.     procedure SetCycleIcons(Value: Boolean);
  127.     procedure SetCycleInterval(Value: Cardinal);
  128.     function InitIcon: Boolean;
  129.     procedure SetIcon(Value: TIcon);
  130.     procedure SetIconVisible(Value: Boolean);
  131. {$IFDEF DELPHI_4_UP}
  132.     procedure SetIconList(Value: TCustomImageList);
  133. {$ELSE}
  134.     procedure SetIconList(Value: TImageList);
  135. {$ENDIF}
  136.     procedure SetIconIndex(Value: Integer);
  137.     procedure SetHint(Value: THintString);
  138.     procedure SetShowHint(Value: Boolean);
  139.     procedure SetWantEnterExitEvents(Value: Boolean);
  140.     procedure SetBehavior(Value: TBehavior);
  141.     procedure IconChanged(Sender: TObject);
  142. {$IFDEF WINNT_SERVICE_HACK}
  143.     function IsWinNT: Boolean;
  144. {$ENDIF}
  145.     // Hook methods
  146.     function HookAppProc(var Msg: TMessage): Boolean;
  147.     procedure HookForm;
  148.     procedure UnhookForm;
  149.     procedure HookFormProc(var Msg: TMessage);
  150.     // SimpleTimer event methods
  151.     procedure ClickTimerProc(Sender: TObject);
  152.     procedure CycleTimerProc(Sender: TObject);
  153.     procedure MouseExitTimerProc(Sender: TObject);
  154.   protected
  155.     IconData: TNotifyIconDataEx;       // Data of the tray icon wnd.
  156.     procedure Loaded; override;
  157.     function LoadDefaultIcon: Boolean; virtual;
  158.     function ShowIcon: Boolean; virtual;
  159.     function HideIcon: Boolean; virtual;
  160.     function ModifyIcon: Boolean; virtual;
  161.     procedure Click; dynamic;
  162.     procedure DblClick; dynamic;
  163.     procedure CycleIcon; dynamic;
  164.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); dynamic;
  165.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); dynamic;
  166.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
  167.     procedure MouseEnter; dynamic;
  168.     procedure MouseExit; dynamic;
  169.     procedure DoMinimizeToTray; dynamic;
  170.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  171.   public
  172.     property Handle: HWND read IconData.hWnd;
  173.     property Behavior: TBehavior read FBehavior write SetBehavior default bhWin95;
  174.     constructor Create(AOwner: TComponent); override;
  175.     destructor Destroy; override;
  176.     function Refresh: Boolean;
  177.     function ShowBalloonHint(Title: String; Text: String; IconType: TBalloonHintIcon;
  178.       TimeoutSecs: TBalloonHintTimeOut): Boolean;
  179.     function HideBalloonHint: Boolean;
  180.     procedure PopupAtCursor;
  181.     function BitmapToIcon(const Bitmap: TBitmap; const Icon: TIcon;
  182.       MaskColor: TColor): Boolean;
  183.     function GetClientIconPos(X, Y: Integer): TPoint;
  184.     function GetTooltipHandle: HWND;
  185.     function GetBalloonHintHandle: HWND;
  186.     //----- SPECIAL: methods that only apply when owner is a form -----
  187.     procedure HideTaskbarIcon;
  188.     procedure ShowTaskbarIcon;
  189.     procedure ShowMainForm;
  190.     procedure HideMainForm;
  191.     //----- END SPECIAL -----
  192.   published
  193.     // Properties:
  194.     property DesignPreview: Boolean read FDesignPreview write SetDesignPreview
  195.       default False;
  196. {$IFDEF DELPHI_4_UP}
  197.     property IconList: TCustomImageList read FIconList write SetIconList;
  198. {$ELSE}
  199.     property IconList: TImageList read FIconList write SetIconList;
  200. {$ENDIF}
  201.     property CycleIcons: Boolean read FCycleIcons write SetCycleIcons
  202.       default False;
  203.     property CycleInterval: Cardinal read FCycleInterval write SetCycleInterval;
  204.     property Enabled: Boolean read FEnabled write FEnabled default True;
  205.     property Hint: THintString read FHint write SetHint;
  206.     property ShowHint: Boolean read FShowHint write SetShowHint default True;
  207.     property Icon: TIcon read FIcon write SetIcon;
  208.     property IconVisible: Boolean read FIconVisible write SetIconVisible
  209.       default False;
  210.     property IconIndex: Integer read FIconIndex write SetIconIndex;
  211.     property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
  212.     property LeftPopup: Boolean read FLeftPopup write FLeftPopup default False;
  213.     property WantEnterExitEvents: Boolean read FWantEnterExitEvents
  214.       write SetWantEnterExitEvents default False;
  215.     //----- SPECIAL: properties that only apply when owner is a form -----
  216.     property MinimizeToTray: Boolean read FMinimizeToTray write FMinimizeToTray
  217.       default False;             // Minimize main form to tray when minimizing?
  218.     //----- END SPECIAL -----
  219.     // Events:
  220.     property OnClick: TNotifyEvent read FOnClick write FOnClick;
  221.     property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
  222.     property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
  223.     property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
  224.     property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
  225.     property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
  226.     property OnMouseExit: TNotifyEvent read FOnMouseExit write FOnMouseExit;
  227.     property OnCycle: TCycleEvent read FOnCycle write FOnCycle;
  228.     property OnBalloonHintShow: TNotifyEvent read FOnBalloonHintShow
  229.       write FOnBalloonHintShow;
  230.     property OnBalloonHintHide: TNotifyEvent read FOnBalloonHintHide
  231.       write FOnBalloonHintHide;
  232.     property OnBalloonHintTimeout: TNotifyEvent read FOnBalloonHintTimeout
  233.       write FOnBalloonHintTimeout;
  234.     property OnBalloonHintClick: TNotifyEvent read FOnBalloonHintClick
  235.       write FOnBalloonHintClick;
  236.     //----- SPECIAL: events that only apply when owner is a form -----
  237.     property OnMinimizeToTray: TNotifyEvent read FOnMinimizeToTray
  238.       write FOnMinimizeToTray;
  239.     property OnStartup: TStartupEvent read FOnStartup write FOnStartup;
  240.     //----- END SPECIAL -----
  241.   end;
  242. implementation
  243. {$IFDEF DELPHI_4_UP}
  244. uses
  245.   ComCtrls;
  246. {$ENDIF}
  247. const
  248.   // Key select events (Space and Enter)
  249.   NIN_SELECT           = WM_USER + 0;
  250.   NINF_KEY             = 1;
  251.   NIN_KEYSELECT        = NINF_KEY or NIN_SELECT;
  252.   // Events returned by balloon hint
  253.   NIN_BALLOONSHOW      = WM_USER + 2;
  254.   NIN_BALLOONHIDE      = WM_USER + 3;
  255.   NIN_BALLOONTIMEOUT   = WM_USER + 4;
  256.   NIN_BALLOONUSERCLICK = WM_USER + 5;
  257.   // Constants used for balloon hint feature
  258.   NIIF_NONE            = $00000000;
  259.   NIIF_INFO            = $00000001;
  260.   NIIF_WARNING         = $00000002;
  261.   NIIF_ERROR           = $00000003;
  262.   NIIF_ICON_MASK       = $0000000F;    // Reserved for WinXP
  263.   NIIF_NOSOUND         = $00000010;    // Reserved for WinXP
  264.   // uFlags constants for TNotifyIconDataEx
  265.   NIF_STATE            = $00000008;
  266.   NIF_INFO             = $00000010;
  267.   NIF_GUID             = $00000020;
  268.   // dwMessage constants for Shell_NotifyIcon
  269.   NIM_SETFOCUS         = $00000003;
  270.   NIM_SETVERSION       = $00000004;
  271.   NOTIFYICON_VERSION   = 3;            // Used with the NIM_SETVERSION message
  272.   // Tooltip constants
  273.   TOOLTIPS_CLASS       = 'tooltips_class32';
  274.   TTS_NOPREFIX         = 2;
  275. type
  276.   TTrayIconHandler = class(TObject)
  277.   private
  278.     RefCount: Cardinal;
  279.     FHandle: HWND;
  280.   public
  281.     constructor Create;
  282.     destructor Destroy; override;
  283.     procedure Add;
  284.     procedure Remove;
  285.     procedure HandleIconMessage(var Msg: TMessage);
  286.   end;
  287. var
  288.   TrayIconHandler: TTrayIconHandler = nil;
  289. {$IFDEF WINNT_SERVICE_HACK}
  290.   WinNT: Boolean = False;              // For Win NT
  291.   HComCtl32: Cardinal = $7FFFFFFF;     // For Win NT
  292. {$ENDIF}
  293.   WM_TASKBARCREATED: Cardinal;
  294.   SHELL_VERSION: Integer;
  295. {------------------ TTrayIconHandler ------------------}
  296. constructor TTrayIconHandler.Create;
  297. begin
  298.   inherited Create;
  299.   RefCount := 0;
  300. {$IFDEF DELPHI_6_UP}
  301.   FHandle := Classes.AllocateHWnd(HandleIconMessage);
  302. {$ELSE}
  303.   FHandle := AllocateHWnd(HandleIconMessage);
  304. {$ENDIF}
  305. end;
  306. destructor TTrayIconHandler.Destroy;
  307. begin
  308. {$IFDEF DELPHI_6_UP}
  309.   Classes.DeallocateHWnd(FHandle);     // Free the tray window
  310. {$ELSE}
  311.   DeallocateHWnd(FHandle);             // Free the tray window
  312. {$ENDIF}
  313.   inherited Destroy;
  314. end;
  315. procedure TTrayIconHandler.Add;
  316. begin
  317.   Inc(RefCount);
  318. end;
  319. procedure TTrayIconHandler.Remove;
  320. begin
  321.   if RefCount > 0 then
  322.     Dec(RefCount);
  323. end;
  324. { HandleIconMessage handles messages that go to the shell notification
  325.   window (tray icon) itself. Most messages are passed through WM_TRAYNOTIFY.
  326.   In these cases we use lParam to get the actual message, eg. WM_MOUSEMOVE.
  327.   The method fires the appropriate event methods like OnClick and OnMouseMove. }
  328. { The message always goes through the container, TrayIconHandler.
  329.   Msg.wParam contains the ID of the TCoolTrayIcon instance, which we stored
  330.   as the object pointer Self in the TCoolTrayIcon constructor. We therefore
  331.   cast wParam to a TCoolTrayIcon instance. }
  332. procedure TTrayIconHandler.HandleIconMessage(var Msg: TMessage);
  333.   function ShiftState: TShiftState;
  334.   // Return the state of the shift, ctrl, and alt keys
  335.   begin
  336.     Result := [];
  337.     if GetAsyncKeyState(VK_SHIFT) < 0 then
  338.       Include(Result, ssShift);
  339.     if GetAsyncKeyState(VK_CONTROL) < 0 then
  340.       Include(Result, ssCtrl);
  341.     if GetAsyncKeyState(VK_MENU) < 0 then
  342.       Include(Result, ssAlt);
  343.   end;
  344. var
  345.   Pt: TPoint;
  346.   Shift: TShiftState;
  347.   I: Integer;
  348.   M: TMenuItem;
  349. {$IFDEF WINNT_SERVICE_HACK}
  350.   InitComCtl32: procedure;
  351. {$ENDIF}
  352. begin
  353.   if Msg.Msg = WM_TRAYNOTIFY then
  354.   // Take action if a message from the tray icon comes through
  355.   begin
  356. {$WARNINGS OFF}
  357.     with TCoolTrayIcon(Msg.wParam) do  // Cast to a TCoolTrayIcon instance
  358. {$WARNINGS ON}
  359.     begin
  360.       case Msg.lParam of
  361.         WM_MOUSEMOVE:
  362.           if FEnabled then
  363.           begin
  364.             // MouseEnter event
  365.             if FWantEnterExitEvents then
  366.               if FDidExit then
  367.               begin
  368.                 MouseEnter;
  369.                 FDidExit := False;
  370.               end;
  371.             // MouseMove event
  372.             Shift := ShiftState;
  373.             GetCursorPos(Pt);
  374.             MouseMove(Shift, Pt.x, Pt.y);
  375.             LastMoveX := Pt.x;
  376.             LastMoveY := Pt.y;
  377.           end;
  378.         WM_LBUTTONDOWN:
  379.           if FEnabled then
  380.           begin
  381.             { If we have no OnDblClick event fire the Click event immediately.
  382.               Otherwise start a timer and wait for a short while to see if user
  383.               clicks again. If he does click again inside this period we have
  384.               a double click in stead of a click. }
  385.             if Assigned(FOnDblClick) then
  386.             begin
  387.               ClickTimer.Interval := GetDoubleClickTime;
  388.               ClickTimer.Enabled := True;
  389.             end;
  390.             Shift := ShiftState + [ssLeft];
  391.             GetCursorPos(Pt);
  392.             MouseDown(mbLeft, Shift, Pt.x, Pt.y);
  393.             FClickStart := True;
  394.             if FLeftPopup then
  395.               PopupAtCursor;
  396.           end;
  397.         WM_RBUTTONDOWN:
  398.           if FEnabled then
  399.           begin
  400.             Shift := ShiftState + [ssRight];
  401.             GetCursorPos(Pt);
  402.             MouseDown(mbRight, Shift, Pt.x, Pt.y);
  403.             PopupAtCursor;
  404.           end;
  405.         WM_MBUTTONDOWN:
  406.           if FEnabled then
  407.           begin
  408.             Shift := ShiftState + [ssMiddle];
  409.             GetCursorPos(Pt);
  410.             MouseDown(mbMiddle, Shift, Pt.x, Pt.y);
  411.           end;
  412.         WM_LBUTTONUP:
  413.           if FEnabled then
  414.           begin
  415.             Shift := ShiftState + [ssLeft];
  416.             GetCursorPos(Pt);
  417.             if FClickStart then   // Then WM_LBUTTONDOWN was called before
  418.               FClickReady := True;
  419.             if FClickStart and (not ClickTimer.Enabled) then
  420.             begin
  421.               { At this point we know a mousedown occured, and the dblclick timer
  422.                 timed out. We have a delayed click. }
  423.               FClickStart := False;
  424.               FClickReady := False;
  425.               Click;              // We have a click
  426.             end;
  427.             FClickStart := False;
  428.             MouseUp(mbLeft, Shift, Pt.x, Pt.y);
  429.           end;
  430.         WM_RBUTTONUP:
  431.           if FBehavior = bhWin95 then
  432.             if FEnabled then
  433.             begin
  434.               Shift := ShiftState + [ssRight];
  435.               GetCursorPos(Pt);
  436.               MouseUp(mbRight, Shift, Pt.x, Pt.y);
  437.             end;
  438.         WM_CONTEXTMENU, NIN_SELECT, NIN_KEYSELECT:
  439.           if FBehavior = bhWin2000 then
  440.             if FEnabled then
  441.             begin
  442.               Shift := ShiftState + [ssRight];
  443.               GetCursorPos(Pt);
  444.               MouseUp(mbRight, Shift, Pt.x, Pt.y);
  445.             end;
  446.         WM_MBUTTONUP:
  447.           if FEnabled then
  448.           begin
  449.             Shift := ShiftState + [ssMiddle];
  450.             GetCursorPos(Pt);
  451.             MouseUp(mbMiddle, Shift, Pt.x, Pt.y);
  452.           end;
  453.         WM_LBUTTONDBLCLK:
  454.           if FEnabled then
  455.           begin
  456.             FClickReady := False;
  457.             IsDblClick := True;
  458.             DblClick;
  459.             { Handle default menu items. But only if LeftPopup is false, or it
  460.               will conflict with the popupmenu when it is called by a click event. }
  461.             M := nil;
  462.             if Assigned(FPopupMenu) then
  463.               if (FPopupMenu.AutoPopup) and (not FLeftPopup) then
  464.                 for I := PopupMenu.Items.Count -1 downto 0 do
  465.                 begin
  466.                   if PopupMenu.Items[I].Default then
  467.                     M := PopupMenu.Items[I];
  468.                 end;
  469.             if M <> nil then
  470.               M.Click;
  471.           end;
  472.         NIN_BALLOONSHOW: begin
  473.           if Assigned(FOnBalloonHintShow) then
  474.             FOnBalloonHintShow(Self);
  475.         end;
  476.         NIN_BALLOONHIDE:
  477.           if Assigned(FOnBalloonHintHide) then
  478.             FOnBalloonHintHide(Self);
  479.         NIN_BALLOONTIMEOUT:
  480.           if Assigned(FOnBalloonHintTimeout) then
  481.             FOnBalloonHintTimeout(Self);
  482.         NIN_BALLOONUSERCLICK:
  483.           if Assigned(FOnBalloonHintClick) then
  484.             FOnBalloonHintClick(Self);
  485.       end;
  486.     end;
  487.   end
  488.   else             // Messages that didn't go through the icon
  489.     case Msg.Msg of
  490.       { Windows sends us a WM_QUERYENDSESSION message when it prepares for
  491.         shutdown. Msg.Result must not return 0, or the system will be unable
  492.         to shut down. The same goes for other specific system messages. }
  493.       WM_CLOSE, WM_QUIT, WM_DESTROY, WM_NCDESTROY: begin
  494.         Msg.Result := 1;
  495.       end;
  496. {
  497.       WM_DESTROY:
  498.         if not (csDesigning in ComponentState) then
  499.         begin
  500.           Msg.Result := 0;
  501.           PostQuitMessage(0);
  502.         end;
  503. }
  504.       WM_QUERYENDSESSION, WM_ENDSESSION: begin
  505.         Msg.Result := 1;
  506.       end;
  507. {$IFDEF WINNT_SERVICE_HACK}
  508.       WM_USERCHANGED:
  509.         if WinNT then begin
  510.           // Special handling for Win NT: Load/unload common controls library
  511.           if HComCtl32 = 0 then
  512.           begin
  513.             // Load and initialize common controls library
  514.             HComCtl32 := LoadLibrary('comctl32.dll');
  515.             { We load the entire dll. This is probably unnecessary.
  516.               The InitCommonControlsEx method may be more appropriate. }
  517.             InitComCtl32 := GetProcAddress(HComCtl32, 'InitCommonControls');
  518.             InitComCtl32;
  519.           end
  520.           else
  521.           begin
  522.             // Unload common controls library (if it is loaded)
  523.             if HComCtl32 <> $7FFFFFFF then
  524.               FreeLibrary(HComCtl32);
  525.             HComCtl32 := 0;
  526.           end;
  527.           Msg.Result := 1;
  528.         end;
  529. {$ENDIF}
  530.     else      // Handle all other messages with the default handler
  531.       Msg.Result := DefWindowProc(FHandle, Msg.Msg, Msg.wParam, Msg.lParam);
  532.     end;
  533. end;
  534. {---------------- Container management ----------------}
  535. procedure AddTrayIcon;
  536. begin
  537.   if not Assigned(TrayIconHandler) then
  538.     // Create new handler
  539.     TrayIconHandler := TTrayIconHandler.Create;
  540.   TrayIconHandler.Add;
  541. end;
  542. procedure RemoveTrayIcon;
  543. begin
  544.   if Assigned(TrayIconHandler) then
  545.   begin
  546.     TrayIconHandler.Remove;
  547.     if TrayIconHandler.RefCount = 0 then
  548.     begin
  549.       // Destroy handler
  550.       TrayIconHandler.Free;
  551.       TrayIconHandler := nil;
  552.     end;
  553.   end;
  554. end;
  555. {------------- SimpleTimer event methods --------------}
  556. procedure TCoolTrayIcon.ClickTimerProc(Sender: TObject);
  557. begin
  558.   ClickTimer.Enabled := False;
  559.   if (not IsDblClick) then
  560.     if FClickReady then
  561.     begin
  562.       FClickReady := False;
  563.       Click;
  564.     end;
  565.   IsDblClick := False;
  566. end;
  567. procedure TCoolTrayIcon.CycleTimerProc(Sender: TObject);
  568. begin
  569.   if Assigned(FIconList) then
  570.   begin
  571.     FIconList.GetIcon(FIconIndex, FIcon);
  572. //    IconChanged(AOwner);
  573.     CycleIcon;             // Call event method
  574.     if FIconIndex < FIconList.Count-1 then
  575.       SetIconIndex(FIconIndex+1)
  576.     else
  577.       SetIconIndex(0);
  578.   end;
  579. end;
  580. procedure TCoolTrayIcon.MouseExitTimerProc(Sender: TObject);
  581. var
  582.   Pt: TPoint;
  583. begin
  584.   if FDidExit then
  585.     Exit;
  586.   GetCursorPos(Pt);
  587.   if (Pt.x < LastMoveX) or (Pt.y < LastMoveY) or
  588.      (Pt.x > LastMoveX) or (Pt.y > LastMoveY) then
  589.   begin
  590.     FDidExit := True;
  591.     MouseExit;
  592.   end;
  593. end;
  594. {------------------- TCoolTrayIcon --------------------}
  595. constructor TCoolTrayIcon.Create(AOwner: TComponent);
  596. begin
  597.   inherited Create(AOwner);
  598.   AddTrayIcon;               // Container management
  599. {$WARNINGS OFF}
  600.   FIconID := Cardinal(Self); // Use Self object pointer as ID
  601. {$WARNINGS ON}
  602.   SettingMDIForm := True;
  603.   FEnabled := True;          // Enabled by default
  604.   FShowHint := True;         // Show hint by default
  605.   SettingPreview := False;
  606.   FIcon := TIcon.Create;
  607.   FIcon.OnChange := IconChanged;
  608.   FillChar(IconData, SizeOf(IconData), 0);
  609.   IconData.cbSize := SizeOf(TNotifyIconDataEx);
  610.   { IconData.hWnd points to procedure to receive callback messages from the icon.
  611.     We set it to our TrayIconHandler instance. }
  612.   IconData.hWnd := TrayIconHandler.FHandle;
  613.   // Add an id for the tray icon
  614.   IconData.uId := FIconID;
  615.   // We want icon, message handling, and tooltips by default
  616.   IconData.uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
  617.   // Message to send to IconData.hWnd when event occurs
  618.   IconData.uCallbackMessage := WM_TRAYNOTIFY;
  619.   // Create SimpleTimers for later use
  620.   CycleTimer := TSimpleTimer.Create;
  621.   CycleTimer.OnTimer := CycleTimerProc;
  622.   ClickTimer := TSimpleTimer.Create;
  623.   ClickTimer.OnTimer := ClickTimerProc;
  624.   ExitTimer := TSimpleTimer.CreateEx(20, MouseExitTimerProc);
  625.   FDidExit := True;          // Prevents MouseExit from firing at startup
  626.   SetDesignPreview(FDesignPreview);
  627.   // Set hook(s)
  628.   if not (csDesigning in ComponentState) then
  629.   begin
  630.     { For MinimizeToTray to work, we need to know when the form is minimized
  631.       (happens when either the application or the main form minimizes).
  632.       The straight-forward way is to make TCoolTrayIcon trap the
  633.       Application.OnMinimize event. However, if you also make use of this
  634.       event in the application, the OnMinimize code used by TCoolTrayIcon
  635.       is discarded.
  636.       The solution is to hook into the app.'s message handling (via HookAppProc).
  637.       You can then catch any message that goes through the app. and still use
  638.       the OnMinimize event. }
  639.     Application.HookMainWindow(HookAppProc);
  640.     { You can hook into the main form (or any other window), allowing you to handle
  641.       any message that window processes. This is necessary in order to properly
  642.       handle when the user minimizes the form using the TASKBAR icon. }
  643.     if Owner is TWinControl then
  644.       HookForm;
  645.   end;
  646. end;
  647. destructor TCoolTrayIcon.Destroy;
  648. begin
  649.   try
  650.     SetIconVisible(False);        // Remove the icon from the tray
  651.     SetDesignPreview(False);      // Remove any DesignPreview icon
  652.     CycleTimer.Free;
  653.     ClickTimer.Free;
  654.     ExitTimer.Free;
  655.     try
  656.       if FIcon <> nil then
  657.         FIcon.Free;
  658.     except
  659.       on Exception do
  660.         // Do nothing; the icon seems to be invalid
  661.     end;
  662.   finally
  663.     // It is important to unhook any hooked processes
  664.     if not (csDesigning in ComponentState) then
  665.     begin
  666.       Application.UnhookMainWindow(HookAppProc);
  667.       if Owner is TWinControl then
  668.         UnhookForm;
  669.     end;
  670.     RemoveTrayIcon;               // Container management
  671.     inherited Destroy;
  672.   end
  673. end;
  674. procedure TCoolTrayIcon.Loaded;
  675. { This method is called when all properties of the component have been
  676.   initialized. The method SetIconVisible must be called here, after the
  677.   tray icon (FIcon) has loaded itself. Otherwise, the tray icon will
  678.   be blank (no icon image).
  679.   Other boolean values must also be set here. }
  680. var
  681.   Show: Boolean;
  682. begin
  683.   inherited Loaded;          // Always call inherited Loaded first
  684.   if Owner is TWinControl then
  685.     if not (csDesigning in ComponentState) then
  686.     begin
  687.       Show := True;
  688.       if Assigned(FOnStartup) then
  689.         FOnStartup(Self, Show);
  690.       if not Show then
  691.       begin
  692.         Application.ShowMainForm := False;
  693.         HideMainForm;
  694.       end;
  695.     end;
  696.   ModifyIcon;
  697.   SetIconVisible(FIconVisible);
  698.   SetCycleIcons(FCycleIcons);
  699.   SetWantEnterExitEvents(FWantEnterExitEvents);
  700.   SetBehavior(FBehavior);
  701. {$IFDEF WINNT_SERVICE_HACK}
  702.   WinNT := IsWinNT;
  703. {$ENDIF}
  704. end;
  705. function TCoolTrayIcon.LoadDefaultIcon: Boolean;
  706. { This method is called to determine whether to assign a default icon to
  707.   the component. Descendant classes (like TextTrayIcon) can override the
  708.   method to change this behavior. }
  709. begin
  710.   Result := True;
  711. end;
  712. procedure TCoolTrayIcon.Notification(AComponent: TComponent; Operation: TOperation);
  713. begin
  714.   inherited Notification(AComponent, Operation);
  715.   // Check if either the imagelist or the popup menu is about to be deleted
  716.   if (AComponent = IconList) and (Operation = opRemove) then
  717.   begin
  718.     FIconList := nil;
  719.     IconList := nil;
  720.   end;
  721.   if (AComponent = PopupMenu) and (Operation = opRemove) then
  722.   begin
  723.     FPopupMenu := nil;
  724.     PopupMenu := nil;
  725.   end;
  726. end;
  727. procedure TCoolTrayIcon.IconChanged(Sender: TObject);
  728. begin
  729.   ModifyIcon;
  730. end;
  731. { All app. messages pass through HookAppProc. You can override the messages
  732.   by not passing them along to Windows (set Result=True). }
  733. function TCoolTrayIcon.HookAppProc(var Msg: TMessage): Boolean;
  734. var
  735.   Show: Boolean;
  736. //  HideForm: Boolean;
  737. begin
  738.   Result := False;  // Should always be False unless we don't want the default message handling
  739.   case Msg.Msg of
  740.     WM_SIZE:
  741.       // Handle MinimizeToTray by capturing minimize event of application
  742.       if Msg.wParam = SIZE_MINIMIZED then
  743.       begin
  744.         if FMinimizeToTray then
  745.           DoMinimizeToTray;
  746.         { You could insert a call to a custom minimize event here, but it would
  747.           behave exactly like Application.OnMinimize, so I see no need for it. }
  748.       end;
  749.     WM_WINDOWPOSCHANGED: begin
  750.       { Handle MDI forms: MDI children cause the app. to be redisplayed on the
  751.         taskbar. We hide it again. This may cause a quick flicker. }
  752.       if SettingMDIForm then
  753.         if Application.MainForm <> nil then
  754.         begin
  755.           if Application.MainForm.FormStyle = fsMDIForm then
  756.           begin
  757.             Show := True;
  758.             if Assigned(FOnStartup) then
  759.               FOnStartup(Self, Show);
  760.             if not Show then
  761.               HideTaskbarIcon;
  762.           end;
  763.           SettingMDIForm := False;     // So we only do this once
  764.         end;
  765.     end;
  766.     WM_SYSCOMMAND:
  767.       // Handle MinimizeToTray by capturing minimize event of application
  768.       if Msg.wParam = SC_RESTORE then
  769.         Application.MainForm.Visible := True;
  770.   end;
  771.   // Show the tray icon if the taskbar has been re-created after an Explorer crash
  772.   if Msg.Msg = WM_TASKBARCREATED then
  773.     if FIconVisible then
  774.       ShowIcon;
  775. end;
  776. procedure TCoolTrayIcon.HookForm;
  777. begin
  778.   if (Owner as TWinControl) <> nil then
  779.   begin
  780.     // Hook the parent window
  781.     OldWndProc := Pointer(GetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC));
  782. {$IFDEF DELPHI_6_UP}
  783.     NewWndProc := Classes.MakeObjectInstance(HookFormProc);
  784. {$ELSE}
  785.     NewWndProc := MakeObjectInstance(HookFormProc);
  786. {$ENDIF}
  787.     SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(NewWndProc));
  788.   end;
  789. end;
  790. procedure TCoolTrayIcon.UnhookForm;
  791. begin
  792.   if ((Owner as TWinControl) <> nil) and (Assigned(OldWndProc)) then
  793.     SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(OldWndProc));
  794.   if Assigned(NewWndProc) then
  795. {$IFDEF DELPHI_6_UP}
  796.     Classes.FreeObjectInstance(NewWndProc);
  797. {$ELSE}
  798.     FreeObjectInstance(NewWndProc);
  799. {$ENDIF}
  800.   NewWndProc := nil;
  801.   OldWndProc := nil;
  802. end;
  803. { All main form messages pass through HookFormProc. You can override the
  804.   messages by not passing them along to Windows (via CallWindowProc).
  805.   You should be careful with the graphical messages, though. }
  806. procedure TCoolTrayIcon.HookFormProc(var Msg: TMessage);
  807.   function DoMinimizeEvents: Boolean;
  808.   begin
  809.     Result := False;
  810.     if FMinimizeToTray then
  811.       if Assigned(FOnMinimizeToTray) then
  812.       begin
  813.         FOnMinimizeToTray(Self);
  814.         DoMinimizeToTray;
  815.         Msg.Result := 1;
  816.         Result := True;
  817.       end;
  818.   end;
  819. begin
  820.   case Msg.Msg of
  821.     WM_SHOWWINDOW: begin
  822.       if (Msg.wParam = 1) and (Msg.lParam = 0) then
  823.       begin
  824.         // Show the taskbar icon (Windows may have shown it already)
  825. //        ShowWindow(Application.Handle, SW_RESTORE);
  826.         // Bring the taskbar icon and the main form to the foreground
  827.         SetForegroundWindow(Application.Handle);
  828.         SetForegroundWindow((Owner as TWinControl).Handle);
  829.       end
  830.       else if (Msg.wParam = 0) and (Msg.lParam = SW_PARENTCLOSING) then
  831.       begin
  832.         // Application is minimizing (or closing), handle MinimizeToTray
  833.         if not Application.Terminated then
  834.           if DoMinimizeEvents then
  835.             Exit;            // Don't pass the message on
  836.       end;
  837.     end;
  838.     WM_SYSCOMMAND:
  839.       // Handle MinimizeToTray by capturing minimize event of form
  840.       if Msg.wParam = SC_MINIMIZE then
  841.         if DoMinimizeEvents then
  842.           Exit;              // Don't pass the message on
  843. {
  844.     This condition was intended to solve the "Windows can't shut down" issue.
  845.     Unfortunately, setting FormStyle or BorderStyle recreates the form, which
  846.     means it receives a WM_DESTROY and WM_NCDESTROY message. Since these are
  847.     not passed on the form simply disappears when setting either property.
  848.     Anyway, if these messages need to be handled (?) they should probably
  849.     be handled at application level, rather than form level.
  850.     WM_DESTROY, WM_NCDESTROY: begin
  851.       Msg.Result := 1;
  852.       Exit;
  853.     end;
  854. }
  855.   end;
  856. {
  857.   case Msg.Msg of
  858.     WM_QUERYENDSESSION: begin
  859.       Msg.Result := 1;
  860.     end;
  861.   else
  862. }
  863.     // Pass the message on
  864.     Msg.Result := CallWindowProc(OldWndProc, (Owner as TWinControl).Handle,
  865.                   Msg.Msg, Msg.wParam, Msg.lParam);
  866. {
  867.   end;
  868. }
  869. end;
  870. procedure TCoolTrayIcon.SetIcon(Value: TIcon);
  871. begin
  872.   FIcon.OnChange := nil;
  873. //  FIcon := Value;
  874.   FIcon.Assign(Value);      
  875.   FIcon.OnChange := IconChanged;
  876.   ModifyIcon;
  877. end;
  878. procedure TCoolTrayIcon.SetIconVisible(Value: Boolean);
  879. begin
  880.   if Value then
  881.     ShowIcon
  882.   else
  883.     HideIcon;
  884. end;
  885. procedure TCoolTrayIcon.SetDesignPreview(Value: Boolean);
  886. begin
  887.   FDesignPreview := Value;
  888.   SettingPreview := True;         // Raise flag
  889.   { Assign a default icon if Icon property is empty. This will assign an icon
  890.     to the component when it is created for the very first time. When the user
  891.     assigns another icon it will not be overwritten next time the project loads.
  892.     HOWEVER, if the user has decided explicitly to have no icon a default icon
  893.     will be inserted regardless. I figured this was a tolerable price to pay. }
  894.   if (csDesigning in ComponentState) then
  895.   begin
  896.     if FIcon.Handle = 0 then
  897.       if LoadDefaultIcon then
  898.         FIcon.Handle := LoadIcon(0, IDI_WINLOGO);
  899.     { It is tempting to assign the application's icon (Application.Icon) as a
  900.       default icon. The problem is there's no Application instance at design time.
  901.       Or is there? Yes there is: the Delphi editor! Application.Icon is the icon
  902.       found in delphi32.exe. How to use:
  903.         FIcon.Assign(Application.Icon);
  904.       Seems to work, but I don't recommend it. Why would you want to, anyway? }
  905.     SetIconVisible(Value);
  906.   end;
  907.   SettingPreview := False;        // Clear flag
  908. end;
  909. procedure TCoolTrayIcon.SetCycleIcons(Value: Boolean);
  910. begin
  911.   FCycleIcons := Value;
  912.   if Value then
  913.     SetIconIndex(0);
  914.   if Value then
  915.   begin
  916.     CycleTimer.Interval := FCycleInterval;
  917.     CycleTimer.Enabled := True;
  918.   end
  919.   else
  920.     CycleTimer.Enabled := False;
  921. end;
  922. procedure TCoolTrayIcon.SetCycleInterval(Value: Cardinal);
  923. begin
  924.   FCycleInterval := Value;
  925.   SetCycleIcons(FCycleIcons);
  926. end;
  927. {$IFDEF DELPHI_4_UP}
  928. procedure TCoolTrayIcon.SetIconList(Value: TCustomImageList);
  929. {$ELSE}
  930. procedure TCoolTrayIcon.SetIconList(Value: TImageList);
  931. {$ENDIF}
  932. begin
  933.   FIconList := Value;
  934. {
  935.   // Set CycleIcons = false if IconList is nil
  936.   if Value = nil then
  937.     SetCycleIcons(False);
  938. }
  939.   SetIconIndex(0);
  940. end;
  941. procedure TCoolTrayIcon.SetIconIndex(Value: Integer);
  942. begin
  943.   if FIconList <> nil then
  944.   begin
  945.     FIconIndex := Value;
  946.     if Value >= FIconList.Count then
  947.       FIconIndex := FIconList.Count -1;
  948.     FIconList.GetIcon(FIconIndex, FIcon);
  949.   end
  950.   else
  951.     FIconIndex := 0;
  952.   ModifyIcon;
  953. end;
  954. procedure TCoolTrayIcon.SetHint(Value: THintString);
  955. begin
  956.   FHint := Value;
  957.   ModifyIcon;
  958. end;
  959. procedure TCoolTrayIcon.SetShowHint(Value: Boolean);
  960. begin
  961.   FShowHint := Value;
  962.   ModifyIcon;
  963. end;
  964. procedure TCoolTrayIcon.SetWantEnterExitEvents(Value: Boolean);
  965. begin
  966.   FWantEnterExitEvents := Value;
  967.   ExitTimer.Enabled := Value;
  968. end;
  969. procedure TCoolTrayIcon.SetBehavior(Value: TBehavior);
  970. begin
  971.   FBehavior := Value;
  972.   case FBehavior of
  973.     bhWin95:   IconData.TimeoutOrVersion.uVersion := 0;
  974.     bhWin2000: IconData.TimeoutOrVersion.uVersion := NOTIFYICON_VERSION;
  975.   end;
  976.   Shell_NotifyIcon(NIM_SETVERSION, @IconData);
  977. end;
  978. function TCoolTrayIcon.InitIcon: Boolean;
  979. // Set icon and tooltip
  980. var
  981.   ok: Boolean;
  982. begin
  983.   Result := False;
  984.   ok := True;
  985.   if (csDesigning in ComponentState) then
  986.     ok := (SettingPreview or FDesignPreview);
  987.   if ok then
  988.   begin
  989.     try
  990.       IconData.hIcon := FIcon.Handle;
  991.     except
  992.       on EReadError do   // Seems the icon was destroyed
  993.       begin
  994.         IconData.hIcon := 0;
  995. //        Exit;
  996.       end;
  997.     end;
  998.     if (FHint <> '') and (FShowHint) then
  999.     begin
  1000.       StrLCopy(IconData.szTip, PChar(String(FHint)), SizeOf(IconData.szTip)-1);
  1001.       { StrLCopy must be used since szTip is only 128 bytes. }
  1002.       { In IE ver. 5 szTip is 128 chars, before that only 64 chars. I suppose
  1003.         I could use GetComCtlVersion to check the version and then truncate
  1004.         the string accordingly, but Windows seems to handle this ok by itself. }
  1005.       IconData.szTip[SizeOf(IconData.szTip)-1] := #0;
  1006.     end
  1007.     else
  1008.       IconData.szTip := '';
  1009.     Result := True;
  1010.   end;
  1011. end;
  1012. function TCoolTrayIcon.ShowIcon: Boolean;
  1013. // Add/show the icon on the tray
  1014. begin
  1015.   Result := False;
  1016.   if not SettingPreview then
  1017.     FIconVisible := True;
  1018.   begin
  1019.     if (csDesigning in ComponentState) then
  1020.     begin
  1021.       if SettingPreview then
  1022.         if InitIcon then
  1023.           Result := Shell_NotifyIcon(NIM_ADD, @IconData);
  1024.     end
  1025.     else
  1026.       if InitIcon then
  1027.         Result := Shell_NotifyIcon(NIM_ADD, @IconData);
  1028.   end;
  1029. end;
  1030. function TCoolTrayIcon.HideIcon: Boolean;
  1031. // Remove/hide the icon from the tray
  1032. begin
  1033.   Result := False;
  1034.   if not SettingPreview then
  1035.     FIconVisible := False;
  1036.   begin
  1037.     if (csDesigning in ComponentState) then
  1038.     begin
  1039.       if SettingPreview then
  1040.         if InitIcon then
  1041.           Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
  1042.     end
  1043.     else
  1044.     if InitIcon then
  1045.       Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
  1046.   end;
  1047. end;
  1048. function TCoolTrayIcon.ModifyIcon: Boolean;
  1049. // Change icon or tooltip if icon already placed
  1050. begin
  1051.   Result := False;
  1052.   if InitIcon then
  1053.     Result := Shell_NotifyIcon(NIM_MODIFY, @IconData);
  1054. end;
  1055. function TCoolTrayIcon.ShowBalloonHint(Title: String; Text: String;
  1056.   IconType: TBalloonHintIcon; TimeoutSecs: TBalloonHintTimeOut): Boolean;
  1057. // Show balloon hint. Return false if error.
  1058. const
  1059.   aBalloonIconTypes: array[TBalloonHintIcon] of Byte =
  1060.     (NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR);
  1061. begin
  1062.   // Remove old balloon hint
  1063.   HideBalloonHint;
  1064.   // Display new balloon hint
  1065.   with IconData do
  1066.   begin
  1067.     uFlags := uFlags or NIF_INFO;
  1068.     StrLCopy(szInfo, PChar(Text), SizeOf(szInfo)-1);
  1069.     StrLCopy(szInfoTitle, PChar(Title), SizeOf(szInfoTitle)-1);
  1070.     TimeoutOrVersion.uTimeout := TimeoutSecs * 1000;
  1071.     dwInfoFlags := aBalloonIconTypes[IconType];
  1072.   end;
  1073.   Result := ModifyIcon;
  1074.   { Remove NIF_INFO before next call to ModifyIcon (or the balloon hint will
  1075.     redisplay itself) }
  1076.   with IconData do
  1077.     uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
  1078. end;
  1079. function TCoolTrayIcon.HideBalloonHint: Boolean;
  1080. // Hide balloon hint. Return false if error.
  1081. begin
  1082.   with IconData do
  1083.   begin
  1084.     uFlags := uFlags or NIF_INFO;
  1085.     StrPCopy(szInfo, '');
  1086.   end;
  1087.   Result := ModifyIcon;
  1088. end;
  1089. function TCoolTrayIcon.BitmapToIcon(const Bitmap: TBitmap;
  1090.   const Icon: TIcon; MaskColor: TColor): Boolean;
  1091. { Render an icon from a 16x16 bitmap. Return false if error.
  1092.   MaskColor is a color that will be rendered transparently. Use clNone for
  1093.   no transparency. }
  1094. var
  1095.   BitmapImageList: TImageList;
  1096. begin
  1097.   BitmapImageList := TImageList.CreateSize(16, 16);
  1098.   try
  1099.     Result := False;
  1100.     BitmapImageList.AddMasked(Bitmap, MaskColor);
  1101.     BitmapImageList.GetIcon(0, Icon);
  1102.     Result := True;
  1103.   finally
  1104.     BitmapImageList.Free;
  1105.   end;
  1106. end;
  1107. function TCoolTrayIcon.GetClientIconPos(X, Y: Integer): TPoint;
  1108. // Return the cursor position inside the tray icon
  1109. const
  1110.   IconBorder = 1;
  1111. //  IconSize = 16;
  1112. var
  1113.   H: HWND;
  1114.   P: TPoint;
  1115.   IconSize: Integer;
  1116. begin
  1117. { The CoolTrayIcon.Handle property is not the window handle of the tray icon.
  1118.   We can find the window handle via WindowFromPoint when the mouse is over
  1119.   the tray icon. (It can probably be found via GetWindowLong as well).
  1120.   BTW: The parent of the tray icon is the TASKBAR - not the traybar, which
  1121.   contains the tray icons and the clock. The traybar seems to be a canvas,
  1122.   not a real window (?). }
  1123.   // Get the icon size
  1124.   IconSize := GetSystemMetrics(SM_CYCAPTION) - 3;
  1125.   P.X := X;
  1126.   P.Y := Y;
  1127.   H := WindowFromPoint(P);
  1128.   { Convert current cursor X,Y coordinates to tray client coordinates.
  1129.     Add borders to tray icon size in the calculations. }
  1130.   Windows.ScreenToClient(H, P);
  1131.   P.X := (P.X mod ((IconBorder*2)+IconSize)) -1;
  1132.   P.Y := (P.Y mod ((IconBorder*2)+IconSize)) -1;
  1133.   Result := P;
  1134. end;
  1135. function TCoolTrayIcon.GetTooltipHandle: HWND;
  1136. { All tray icons (but not the clock) share the same tooltip.
  1137.   Return the tooltip handle or 0 if error. }
  1138. var
  1139.   wnd, lTaskBar: HWND;
  1140.   pidTaskBar, pidWnd: DWORD;
  1141. begin
  1142.   // Get the TaskBar handle
  1143.   lTaskBar := FindWindowEx(0, 0, 'Shell_TrayWnd', nil);
  1144.   // Get the TaskBar Process ID
  1145.   GetWindowThreadProcessId(lTaskBar, @pidTaskBar);
  1146.   // Enumerate all tooltip windows
  1147.   wnd := FindWindowEx(0, 0, TOOLTIPS_CLASS, nil);
  1148.   while wnd <> 0 do
  1149.   begin
  1150.     // Get the tooltip process ID
  1151.     GetWindowThreadProcessId(wnd, @pidWnd);
  1152.     { Compare the process ID of the taskbar and the tooltip.
  1153.       If they are the same we have one of the taskbar tooltips. }
  1154.     if pidTaskBar = pidWnd then
  1155.       { Get the tooltip style. The tooltip for tray icons does not have the
  1156.         TTS_NOPREFIX style. }
  1157.       if (GetWindowLong(wnd, GWL_STYLE) and TTS_NOPREFIX) = 0 then
  1158.         Break;
  1159.     wnd := FindWindowEx(0, wnd, TOOLTIPS_CLASS, nil);
  1160.   end;
  1161.   Result := wnd;
  1162. end;
  1163. function TCoolTrayIcon.GetBalloonHintHandle: HWND;
  1164. { All applications share the same balloon hint.
  1165.   Return the balloon hint handle or 0 if error. }
  1166. var
  1167.   wnd, lTaskBar: HWND;
  1168.   pidTaskBar, pidWnd: DWORD;
  1169. begin
  1170.   // Get the TaskBar handle
  1171.   lTaskBar := FindWindowEx(0, 0, 'Shell_TrayWnd', nil);
  1172.   // Get the TaskBar Process ID
  1173.   GetWindowThreadProcessId(lTaskBar, @pidTaskBar);
  1174.   // Enumerate all tooltip windows
  1175.   wnd := FindWindowEx(0, 0, TOOLTIPS_CLASS, nil);
  1176.   while wnd <> 0 do
  1177.   begin
  1178.     // Get the tooltip process ID
  1179.     GetWindowThreadProcessId(wnd, @pidWnd);
  1180.     { Compare the process ID of the taskbar and the tooltip.
  1181.       If they are the same we have one of the taskbar tooltips. }
  1182.     if pidTaskBar = pidWnd then
  1183.       // We don't want windows with the TTS_NOPREFIX style. That's the simple tooltip.
  1184.       if (GetWindowLong(wnd, GWL_STYLE) and TTS_NOPREFIX) <> 0 then
  1185.         Break;
  1186.         
  1187.     wnd := FindWindowEx(0, wnd, TOOLTIPS_CLASS, nil);
  1188.   end;
  1189.   Result := wnd;
  1190. end;
  1191. function TCoolTrayIcon.Refresh: Boolean;
  1192. // Refresh the icon
  1193. begin
  1194.   Result := ModifyIcon;
  1195. end;
  1196. procedure TCoolTrayIcon.PopupAtCursor;
  1197. var
  1198.   CursorPos: TPoint;
  1199. begin
  1200.   if Assigned(PopupMenu) then
  1201.     if PopupMenu.AutoPopup then
  1202.       if GetCursorPos(CursorPos) then
  1203.       begin
  1204.         // Bring the main form (or its modal dialog) to the foreground
  1205.         SetForegroundWindow(Application.Handle);
  1206.         { Win98 (unlike other Windows versions) empties a popup menu before
  1207.           closing it. This is a problem when the menu is about to display
  1208.           while it already is active (two click-events in succession). The
  1209.           menu will flicker annoyingly. Calling ProcessMessages fixes this. }
  1210.         Application.ProcessMessages;
  1211.         // Now make the menu pop up
  1212.         PopupMenu.PopupComponent := Self;
  1213.         PopupMenu.Popup(CursorPos.X, CursorPos.Y);
  1214.         // Remove the popup again in case user deselects it
  1215.         if Owner is TWinControl then   // Owner might be of type TService
  1216.           // Post an empty message to the owner form so popup menu disappears
  1217.           PostMessage((Owner as TWinControl).Handle, WM_NULL, 0, 0)
  1218. {
  1219.         else
  1220.           // Owner is not a form; send the empty message to the app.
  1221.           PostMessage(Application.Handle, WM_NULL, 0, 0);
  1222. }
  1223.       end;
  1224. end;
  1225. procedure TCoolTrayIcon.Click;
  1226. begin
  1227.   if Assigned(FOnClick) then
  1228.     FOnClick(Self);
  1229. end;
  1230. procedure TCoolTrayIcon.DblClick;
  1231. begin
  1232.   if Assigned(FOnDblClick) then
  1233.     FOnDblClick(Self);
  1234. end;
  1235. procedure TCoolTrayIcon.MouseDown(Button: TMouseButton; Shift: TShiftState;
  1236.   X, Y: Integer);
  1237. begin
  1238.   if Assigned(FOnMouseDown) then
  1239.     FOnMouseDown(Self, Button, Shift, X, Y);
  1240. end;
  1241. procedure TCoolTrayIcon.MouseUp(Button: TMouseButton; Shift: TShiftState;
  1242.   X, Y: Integer);
  1243. begin
  1244.   if Assigned(FOnMouseUp) then
  1245.     FOnMouseUp(Self, Button, Shift, X, Y);
  1246. end;
  1247. procedure TCoolTrayIcon.MouseMove(Shift: TShiftState; X, Y: Integer);
  1248. begin
  1249.   if Assigned(FOnMouseMove) then
  1250.     FOnMouseMove(Self, Shift, X, Y);
  1251. end;
  1252. procedure TCoolTrayIcon.MouseEnter;
  1253. begin
  1254.   if Assigned(FOnMouseEnter) then
  1255.     FOnMouseEnter(Self);
  1256. end;
  1257. procedure TCoolTrayIcon.MouseExit;
  1258. begin
  1259.   if Assigned(FOnMouseExit) then
  1260.     FOnMouseExit(Self);
  1261. end;
  1262. procedure TCoolTrayIcon.CycleIcon;
  1263. var
  1264.   NextIconIndex: Integer;
  1265. begin
  1266.   NextIconIndex := 0;
  1267.   if FIconList <> nil then
  1268.     if FIconIndex < FIconList.Count then
  1269.       NextIconIndex := FIconIndex +1;
  1270.   if Assigned(FOnCycle) then
  1271.     FOnCycle(Self, NextIconIndex);
  1272. end;
  1273. procedure TCoolTrayIcon.DoMinimizeToTray;
  1274. begin
  1275.   // Override this method to change automatic tray minimizing behavior
  1276.   HideMainForm;
  1277.   IconVisible := True;
  1278. end;
  1279. {$IFDEF WINNT_SERVICE_HACK}
  1280. function TCoolTrayIcon.IsWinNT: Boolean;
  1281. var
  1282.   ovi: TOSVersionInfo;
  1283.   rc: Boolean;
  1284. begin
  1285.   rc := False;
  1286.   ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  1287.   if GetVersionEx(ovi) then
  1288.   begin
  1289.     rc := (ovi.dwPlatformId = VER_PLATFORM_WIN32_NT) and (ovi.dwMajorVersion <= 4);
  1290.   end;
  1291.   Result := rc;
  1292. end;
  1293. {$ENDIF}
  1294. procedure TCoolTrayIcon.HideTaskbarIcon;
  1295. begin
  1296.   if IsWindowVisible(Application.Handle) then
  1297.     ShowWindow(Application.Handle, SW_HIDE);
  1298. end;
  1299. procedure TCoolTrayIcon.ShowTaskbarIcon;
  1300. begin
  1301.   if not IsWindowVisible(Application.Handle) then
  1302.     ShowWindow(Application.Handle, SW_SHOW);
  1303. end;
  1304. procedure TCoolTrayIcon.ShowMainForm;
  1305. begin
  1306.   if Owner is TWinControl then         // Owner might be of type TService
  1307.     if Application.MainForm <> nil then
  1308.     begin
  1309.       // Restore the app, but don't automatically show its taskbar icon
  1310.       // Show application's TASKBAR icon (not the tray icon)
  1311. //      ShowWindow(Application.Handle, SW_RESTORE);
  1312.       Application.Restore;
  1313.       // Show the form itself
  1314.       if Application.MainForm.WindowState = wsMinimized then
  1315.         Application.MainForm.WindowState := wsNormal;    // Override minimized state
  1316.       Application.MainForm.Visible := True;
  1317.       // Bring the main form (or its modal dialog) to the foreground
  1318.       SetForegroundWindow(Application.Handle);
  1319.     end;
  1320. end;
  1321. procedure TCoolTrayIcon.HideMainForm;
  1322. begin
  1323.   if Owner is TWinControl then         // Owner might be of type TService
  1324.     if Application.MainForm <> nil then
  1325.     begin
  1326.       // Hide the form itself (and thus any child windows)
  1327.       Application.MainForm.Visible := False;
  1328.       { Hide application's TASKBAR icon (not the tray icon). Do this AFTER
  1329.         the main form is hidden, or any child windows will redisplay the
  1330.         taskbar icon if they are visible. }
  1331.       HideTaskbarIcon;
  1332.     end;
  1333. end;
  1334. initialization
  1335. {$IFDEF DELPHI_4_UP}
  1336.   // Get shell version
  1337.   SHELL_VERSION := GetComCtlVersion;
  1338.   // Use the TaskbarCreated message available from Win98/IE4+
  1339.   if SHELL_VERSION >= ComCtlVersionIE4 then
  1340. {$ENDIF}
  1341.     WM_TASKBARCREATED := RegisterWindowMessage('TaskbarCreated');
  1342. finalization
  1343.   if Assigned(TrayIconHandler) then
  1344.   begin
  1345.     // Destroy handler
  1346.     TrayIconHandler.Free;
  1347.     TrayIconHandler := nil;
  1348.   end;
  1349. end.