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