home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 December / Chip_2002-12_cd1.bin / zkuste / delphi / kompon / d234567 / COOLTRAY.ZIP / CoolTrayIcon.pas < prev    next >
Pascal/Delphi Source File  |  2002-10-03  |  47KB  |  1,533 lines

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