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

Delphi控件源码

开发平台:

Delphi

  1. {*******************************************************************}
  2. {                                                                   }
  3. {       Almediadev Visual Component Library                         }
  4. {       BusinessSkinForm                                            }
  5. {       Version 2.90                                                }
  6. {                                                                   }
  7. {       Copyright (c) 2000-2004 Almediadev                          }
  8. {       ALL RIGHTS RESERVED                                         }
  9. {                                                                   }
  10. {       Home:  http://www.almdev.com                                }
  11. {       Support: support@almdev.com                                 }
  12. {                                                                   }
  13. {*******************************************************************}
  14. unit bsTrayIcon;
  15. {$P+,S-,W-,R-}
  16. {$WARNINGS OFF}
  17. {$HINTS OFF}
  18. interface
  19. uses
  20.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  21.   Menus, ShellApi, ExtCtrls, bsSkinMenus;
  22. const
  23.   WM_TRAYNOTIFY = WM_USER + 1024;
  24.   IconID = 1;
  25. var
  26.   WM_TASKBARCREATED: Cardinal;
  27. type
  28.   TbsNotifyIconDataEx = record
  29.     cbSize: DWORD;
  30.     Wnd: HWND;
  31.     uID: UINT;
  32.     uFlags: UINT;
  33.     uCallbackMessage: UINT;
  34.     hIcon: HICON;
  35.     szTip: array[0..127] of AnsiChar;
  36.     dwState: DWORD;
  37.     dwStateMask: DWORD;
  38.     szInfo: array[0..255] of AnsiChar;
  39.     uTimeout: UINT;
  40.     szInfoTitle: array[0..63] of AnsiChar;
  41.     dwInfoFlags: DWORD;
  42.   end;
  43.   TbsCycleEvent = procedure(Sender: TObject; NextIndex: Integer) of object;
  44.   TbsBalloonHintIcon = (bitNone, bitInfo, bitWarning, bitError);
  45.   TbsTrayIcon = class(TComponent)
  46.   private
  47.     FEnabled: Boolean;
  48.     FIcon: TIcon;
  49.     FIconVisible: Boolean;
  50.     FHint: String;
  51.     FShowHint: Boolean;
  52.     FPopupMenu: TbsSkinPopupMenu;
  53.     FPopupByLeftButton: Boolean;
  54.     FOnClick,
  55.     FOnDblClick: TNotifyEvent;
  56.     FOnCycle: TbsCycleEvent;
  57.     FOnMouseDown,
  58.     FOnMouseUp: TMouseEvent;
  59.     FOnMouseMove: TMouseMoveEvent;
  60.     FMinimizedOnStart: Boolean;
  61.     FMinimizeToTray: Boolean;
  62.     FClickStart: Boolean;
  63.     FClickReady: Boolean;
  64.     AnimateTimer: TTimer;
  65.     ClickTimer: TTimer;
  66.     IsDblClick: Boolean;
  67.     FIconIndex: Integer;
  68.     FDesignPreview: Boolean;
  69.     SettingPreview: Boolean;
  70.     SettingMDIForm: Boolean;           
  71.     FIconList: TImageList;
  72.     FCycleIcons: Boolean;
  73.     FAnimateTimerInterval: Cardinal;
  74.     OldAppProc, NewAppProc: Pointer;
  75.     OldWndProc, NewWndProc: Pointer;
  76.     FWindowHandle: HWND;               
  77.     procedure SetDesignPreview(Value: Boolean);
  78.     procedure SetCycleIcons(Value: Boolean);
  79.     procedure SetAnimateTimerInterval(Value: Cardinal);
  80.     procedure TimerCycle(Sender: TObject);
  81.     procedure TimerClick(Sender: TObject);
  82.     procedure HandleIconMessage(var Msg: TMessage);
  83.     function InitIcon: Boolean;
  84.     procedure SetIcon(Value: TIcon);
  85.     procedure SetIconVisible(Value: Boolean);
  86.     procedure SetIconList(Value: TImageList);
  87.     procedure SetIconIndex(Value: Integer);
  88.     procedure SetHint(Value: String);
  89.     procedure SetShowHint(Value: Boolean);
  90.     procedure PopupAtCursor;
  91.     // Hook methods
  92.     procedure HookApp;
  93.     procedure UnhookApp;
  94.     procedure HookAppProc(var Msg: TMessage);
  95.     procedure HookForm;
  96.     procedure UnhookForm;
  97.     procedure HookFormProc(var Msg: TMessage);
  98.   protected
  99.     IconData: TbsNotifyIconDataEx;       
  100.     procedure Loaded; override;
  101.     function LoadDefaultIcon: Boolean; virtual;
  102.     function ShowIcon: Boolean; virtual;
  103.     function HideIcon: Boolean; virtual;
  104.     function ModifyIcon: Boolean; virtual;
  105.     procedure Click; dynamic;
  106.     procedure DblClick; dynamic;
  107.     procedure CycleIcon; dynamic;
  108.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  109.       X, Y: Integer); dynamic;
  110.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  111.       X, Y: Integer); dynamic;
  112.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
  113.     procedure DoMinimizeToTray; dynamic;
  114.     procedure Notification(AComponent: TComponent; Operation: TOperation);
  115.       override;
  116.   public
  117.     property Handle: HWND read IconData.Wnd;
  118.     property WindowHandle: HWND read FWindowHandle;
  119.     constructor Create(AOwner: TComponent); override;
  120.     destructor Destroy; override;
  121.     function Refresh: Boolean;
  122.     function BitmapToIcon(const Bitmap: TBitmap; const Icon: TIcon;
  123.       MaskColor: TColor): Boolean;
  124.     procedure ShowMainForm;
  125.     procedure HideMainForm;
  126.     function ShowBalloonHint(Title: String; Text: String;
  127.                              IconType: TbsBalloonHintIcon): Boolean;
  128.     function HideBalloonHint: Boolean;
  129.   published
  130.     property DesignPreview: Boolean read FDesignPreview
  131.       write SetDesignPreview default False;
  132.     property IconList: TImageList read FIconList write SetIconList;
  133.     property CycleIcons: Boolean read FCycleIcons write SetCycleIcons
  134.       default False;
  135.     property AnimateTimerInterval: Cardinal read FAnimateTimerInterval
  136.       write SetAnimateTimerInterval;
  137.     property Enabled: Boolean read FEnabled write FEnabled default True;
  138.     property Hint: String read FHint write SetHint;
  139.     property ShowHint: Boolean read FShowHint write SetShowHint
  140.       default True;
  141.     property Icon: TIcon read FIcon write SetIcon stored True;
  142.     property IconVisible: Boolean read FIconVisible write SetIconVisible
  143.       default True;
  144.     property IconIndex: Integer read FIconIndex write SetIconIndex;
  145.     property PopupMenu: TbsSkinPopupMenu read FPopupMenu write FPopupMenu;
  146.     property PopupByLeftButton: Boolean read FPopupByLeftButton write FPopupByLeftButton
  147.       default False;
  148.     property MinimizedOnStart: Boolean read FMinimizedOnStart write FMinimizedOnStart
  149.       default False;
  150.     property MinimizeToTray: Boolean read FMinimizeToTray write FMinimizeToTray
  151.       default False;         
  152.     property OnClick: TNotifyEvent read FOnClick write FOnClick;
  153.     property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
  154.     property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
  155.     property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
  156.     property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
  157.     property OnCycle: TbsCycleEvent read FOnCycle write FOnCycle;
  158.   end;
  159. implementation
  160. const
  161.   NIIF_NONE            = $00000000;
  162.   NIIF_INFO            = $00000001;
  163.   NIIF_WARNING         = $00000002;
  164.   NIIF_ERROR           = $00000003;
  165.   NIF_INFO             = $00000010;
  166. constructor TbsTrayIcon.Create(AOwner: TComponent);
  167. begin
  168.   inherited Create(AOwner);
  169.   SettingMDIForm := True;
  170.   FIconVisible := True;
  171.   FMinimizeToTray := True;
  172.   FEnabled := True;
  173.   FShowHint := True;         
  174.   SettingPreview := False;
  175.   WM_TASKBARCREATED := RegisterWindowMessage('TaskbarCreated');
  176.   FIcon := TIcon.Create;
  177.   IconData.cbSize := SizeOf(TbsNotifyIconDataEx);
  178.   IconData.wnd := AllocateHWnd(HandleIconMessage);
  179.   IconData.uId := IconID;
  180.   IconData.uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
  181.   IconData.uCallbackMessage := WM_TRAYNOTIFY;
  182.   FWindowHandle := GetWindowLong(IconData.wnd, GWL_HWNDPARENT);
  183.   AnimateTimer := TTimer.Create(Self);
  184.   AnimateTimer.Enabled := False;
  185.   AnimateTimer.Interval := FAnimateTimerInterval;
  186.   AnimateTimer.OnTimer := TimerCycle;
  187.   ClickTimer := TTimer.Create(Self);
  188.   ClickTimer.Enabled := False;
  189.   ClickTimer.Interval := GetDoubleClickTime;
  190.   ClickTimer.OnTimer := TimerClick;
  191.   if not (csDesigning in ComponentState)
  192.   then
  193.     begin
  194.       if FIcon.Handle = 0
  195.       then
  196.         if LoadDefaultIcon
  197.         then
  198.           FIcon.Handle := Application.Icon.Handle;
  199.       HookApp;
  200.       if Owner is TWinControl then HookForm;
  201.     end;
  202. end;
  203. destructor TbsTrayIcon.Destroy;
  204. begin
  205.   SetIconVisible(False);
  206.   SetDesignPreview(False);
  207.   FIcon.Free;
  208.   DeallocateHWnd(IconData.Wnd);
  209.   AnimateTimer.Free;
  210.   ClickTimer.Free;
  211.   if not (csDesigning in ComponentState)
  212.   then
  213.     begin
  214.       UnhookApp;
  215.       if Owner is TWinControl then UnhookForm;
  216.     end;
  217.   inherited Destroy;
  218. end;
  219. procedure TbsTrayIcon.Loaded;
  220. begin
  221.   inherited Loaded;
  222.   if Owner is TWinControl
  223.   then
  224.     if (FMinimizedOnStart) and not (csDesigning in ComponentState)
  225.     then
  226.       begin
  227.         FIconVisible := True;
  228.         MinimizeToTray := True;
  229.         Application.ShowMainForm := False;
  230.         ShowWindow(Application.Handle, SW_HIDE);
  231.       end;
  232.   ModifyIcon;
  233.   SetIconVisible(FIconVisible);
  234. end;
  235. function TbsTrayIcon.LoadDefaultIcon: Boolean;
  236. begin
  237.   Result := True;
  238. end;
  239. procedure TbsTrayIcon.Notification(AComponent: TComponent;
  240.   Operation: TOperation);
  241. begin
  242.   inherited Notification(AComponent, Operation);
  243.   if (AComponent = FIconList) and (Operation = opRemove)
  244.   then
  245.     begin
  246.       FIconList := nil;
  247.     end;
  248.   if (AComponent = FPopupMenu) and (Operation = opRemove)
  249.   then
  250.     begin
  251.       FPopupMenu := nil;
  252.     end;
  253. end;
  254. procedure TbsTrayIcon.HookApp;
  255. begin
  256.   OldAppProc := Pointer(GetWindowLong(Application.Handle, GWL_WNDPROC));
  257.   NewAppProc := MakeObjectInstance(HookAppProc);
  258.   SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(NewAppProc));
  259. end;
  260. procedure TbsTrayIcon.UnhookApp;
  261. begin
  262.   if Assigned(OldAppProc)
  263.   then
  264.     SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldAppProc));
  265.   if Assigned(NewAppProc)
  266.   then
  267.     FreeObjectInstance(NewAppProc);
  268.   NewAppProc := nil;
  269.   OldAppProc := nil;
  270. end;
  271. procedure TbsTrayIcon.HookAppProc(var Msg: TMessage);
  272. begin
  273.   case Msg.Msg of
  274.     WM_SIZE:
  275.       if Msg.wParam = SIZE_MINIMIZED
  276.       then
  277.         begin
  278.           if FMinimizeToTray then DoMinimizeToTray;
  279.         end;
  280.     WM_WINDOWPOSCHANGED:
  281.       begin
  282.         if SettingMDIForm
  283.         then
  284.           if Application.MainForm <> nil
  285.           then
  286.             begin
  287.               if (Application.MainForm.FormStyle = fsMDIForm) then
  288.               if FMinimizedOnStart then
  289.               ShowWindow(Application.Handle, SW_HIDE);
  290.               SettingMDIForm := False;
  291.             end;
  292.       end;
  293.   end;
  294.   if (Msg.Msg = WM_TASKBARCREATED) and FIconVisible then ShowIcon;
  295.   Msg.Result := CallWindowProc(OldAppProc, Application.Handle,
  296.                                Msg.Msg, Msg.wParam, Msg.lParam);
  297. end;
  298. procedure TbsTrayIcon.HookForm;
  299. begin
  300.   if (Owner as TWinControl) <> nil
  301.   then
  302.     begin
  303.       OldWndProc := Pointer(GetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC));
  304.       NewWndProc := MakeObjectInstance(HookFormProc);
  305.       SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(NewWndProc));
  306.     end;
  307. end;
  308. procedure TbsTrayIcon.UnhookForm;
  309. begin
  310.   if ((Owner as TWinControl) <> nil) and (Assigned(OldWndProc))
  311.   then
  312.     SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(OldWndProc));
  313.   if Assigned(NewWndProc)
  314.   then
  315.     FreeObjectInstance(NewWndProc);
  316.   NewWndProc := nil;
  317.   OldWndProc := nil;
  318. end;
  319. procedure TbsTrayIcon.HookFormProc(var Msg: TMessage);
  320. begin
  321.   case Msg.Msg of
  322.     WM_SHOWWINDOW:
  323.      begin
  324.        if (Msg.lParam = 0) and (Msg.wParam = 1)
  325.        then
  326.          begin
  327.            ShowWindow(Application.Handle, SW_RESTORE);
  328.            SetForegroundWindow(Application.Handle);
  329.            SetForegroundWindow((Owner as TWinControl).Handle);
  330.          end;
  331.      end;
  332.     WM_ACTIVATE: begin
  333.        if Assigned(Screen.ActiveControl)
  334.        then
  335.         if (Msg.WParamLo = WA_ACTIVE) or (Msg.WParamLo = WA_CLICKACTIVE)
  336.         then
  337.           if Assigned(Screen.ActiveControl.Parent)
  338.           then
  339.             begin
  340.               if HWND(Msg.lParam) <> Screen.ActiveControl.Parent.Handle
  341.               then SetFocus(Screen.ActiveControl.Handle);
  342.             end
  343.         else
  344.           begin
  345.             if HWND(Msg.lParam) <> Screen.ActiveControl.Handle
  346.             then SetFocus(Screen.ActiveControl.Handle);
  347.           end;
  348.     end;
  349.   end;
  350.   Msg.Result := CallWindowProc(OldWndProc, (Owner as TWinControl).Handle,
  351.                 Msg.Msg, Msg.wParam, Msg.lParam);
  352. end;
  353. procedure TbsTrayIcon.HandleIconMessage(var Msg: TMessage);
  354.   function ShiftState: TShiftState;
  355.   begin
  356.     Result := [];
  357.     if GetAsyncKeyState(VK_SHIFT) < 0
  358.     then Include(Result, ssShift);
  359.     if GetAsyncKeyState(VK_CONTROL) < 0
  360.     then Include(Result, ssCtrl);
  361.     if GetAsyncKeyState(VK_MENU) < 0
  362.     then Include(Result, ssAlt);
  363.   end;
  364. var
  365.   Pt: TPoint;
  366.   Shift: TShiftState;
  367.   I: Integer;
  368.   M: TMenuItem;
  369. begin
  370.   if Msg.Msg = WM_TRAYNOTIFY
  371.   then
  372.     begin
  373.       if FEnabled then
  374.         case Msg.lParam of
  375.            WM_MOUSEMOVE:
  376.              begin
  377.                Shift := ShiftState;
  378.                GetCursorPos(Pt);
  379.                MouseMove(Shift, Pt.X, Pt.Y);
  380.              end;
  381.            WM_LBUTTONDOWN:
  382.              begin
  383.                ClickTimer.Enabled := True;
  384.                Shift := ShiftState + [ssLeft];
  385.                GetCursorPos(Pt);
  386.                MouseDown(mbLeft, Shift, Pt.X, Pt.Y);
  387.                FClickStart := True;
  388.               if FPopupByLeftButton then PopupAtCursor;
  389.             end;
  390.            WM_RBUTTONDOWN:
  391.              begin
  392.                Shift := ShiftState + [ssRight];
  393.                GetCursorPos(Pt);
  394.                MouseDown(mbRight, Shift, Pt.X, Pt.Y);
  395.                PopupAtCursor;
  396.              end;
  397.            WM_MBUTTONDOWN:
  398.              begin
  399.                Shift := ShiftState + [ssMiddle];
  400.                GetCursorPos(Pt);
  401.                MouseDown(mbMiddle, Shift, Pt.X, Pt.Y);
  402.              end;
  403.            WM_LBUTTONUP:
  404.              begin
  405.                Shift := ShiftState + [ssLeft];
  406.                GetCursorPos(Pt);
  407.                if FClickStart then FClickReady := True;
  408.                if FClickStart and (not ClickTimer.Enabled)
  409.                then
  410.                  begin
  411.                    FClickStart := False;
  412.                    FClickReady := False;
  413.                     Click;
  414.                  end;
  415.                FClickStart := False;
  416.                MouseUp(mbLeft, Shift, Pt.X, Pt.Y);
  417.              end;
  418.            WM_RBUTTONUP:
  419.              begin
  420.                Shift := ShiftState + [ssRight];
  421.                GetCursorPos(Pt);
  422.                MouseUp(mbRight, Shift, Pt.X, Pt.Y);
  423.              end;
  424.            WM_MBUTTONUP:
  425.              begin
  426.                Shift := ShiftState + [ssMiddle];
  427.                GetCursorPos(Pt);
  428.                MouseUp(mbMiddle, Shift, Pt.X, Pt.Y);
  429.              end;
  430.            WM_LBUTTONDBLCLK:
  431.              begin
  432.                FClickReady := False;
  433.                IsDblClick := True;
  434.                DblClick;
  435.                M := nil;
  436.                if Assigned(FPopupMenu)
  437.                then
  438.                  if (FPopupMenu.AutoPopup) and (not FPopupByLeftButton)
  439.                  then
  440.                    for I := PopupMenu.Items.Count -1 downto 0 do
  441.                      if PopupMenu.Items[I].Default then M := PopupMenu.Items[I];
  442.                if M <> nil then M.Click;
  443.              end;
  444.         end;
  445.     end
  446.   else
  447.     case Msg.Msg of
  448.       WM_QUERYENDSESSION, WM_CLOSE, WM_QUIT,
  449.       WM_DESTROY, WM_NCDESTROY, WM_USERCHANGED:  Msg.Result := 1;
  450.     else
  451.       Msg.Result := DefWindowProc(IconData.Wnd, Msg.Msg, Msg.wParam, Msg.lParam);
  452.     end;
  453. end;
  454. procedure TbsTrayIcon.SetIcon(Value: TIcon);
  455. begin
  456.   FIcon.Assign(Value);
  457.   ModifyIcon;
  458. end;
  459. procedure TbsTrayIcon.SetIconVisible(Value: Boolean);
  460. begin
  461.   if Value then ShowIcon else HideIcon;
  462. end;
  463. procedure TbsTrayIcon.SetDesignPreview(Value: Boolean);
  464. begin
  465.   FDesignPreview := Value;
  466.   SettingPreview := True;
  467.   SetIconVisible(Value);
  468.   SettingPreview := False;
  469. end;
  470. procedure TbsTrayIcon.SetCycleIcons(Value: Boolean);
  471. begin
  472.   FCycleIcons := Value;
  473.   if Value then SetIconIndex(0);
  474.   AnimateTimer.Enabled := Value;
  475. end;
  476. procedure TbsTrayIcon.SetAnimateTimerInterval(Value: Cardinal);
  477. begin
  478.   FAnimateTimerInterval := Value;
  479.   AnimateTimer.Interval := FAnimateTimerInterval;
  480. end;
  481. procedure TbsTrayIcon.SetIconList(Value: TImageList);
  482. begin
  483.   FIconList := Value;
  484.   SetIconIndex(0);
  485. end;
  486. procedure TbsTrayIcon.SetIconIndex(Value: Integer);
  487. begin
  488.   if FIconList <> nil
  489.   then
  490.     begin
  491.       FIconIndex := Value;
  492.       if Value >= FIconList.Count then FIconIndex := FIconList.Count - 1;
  493.       FIconList.GetIcon(FIconIndex, FIcon);
  494.     end
  495.   else
  496.     FIconIndex := 0;
  497.   ModifyIcon;
  498. end;
  499. procedure TbsTrayIcon.SetHint(Value: String);
  500. begin
  501.   FHint := Value;
  502.   ModifyIcon;
  503. end;
  504. procedure TbsTrayIcon.SetShowHint(Value: Boolean);
  505. begin
  506.   FShowHint := Value;
  507.   ModifyIcon;
  508. end;
  509. function TbsTrayIcon.InitIcon: Boolean;
  510. var
  511.   B: Boolean;
  512. begin
  513.   Result := False;
  514.   B := True;
  515.   if (csDesigning in ComponentState)
  516.   then
  517.     begin
  518.       if SettingPreview then B := True else B := FDesignPreview
  519.     end;
  520.   if B
  521.   then
  522.     begin
  523.       IconData.hIcon := FIcon.Handle;
  524.       if (FHint <> '') and (FShowHint)
  525.       then
  526.         StrLCopy(IconData.szTip, PChar(FHint), SizeOf(IconData.szTip) - 1)
  527.       else
  528.         IconData.szTip := '';
  529.       Result := True;
  530.     end;
  531. end;
  532. function TbsTrayIcon.ShowIcon: Boolean;
  533. begin
  534.   Result := False;
  535.   if not SettingPreview then FIconVisible := True;
  536.   if (csDesigning in ComponentState)
  537.   then
  538.     begin
  539.       if SettingPreview and InitIcon
  540.       then Result := Shell_NotifyIcon(NIM_ADD, @IconData);
  541.     end
  542.   else
  543.     if InitIcon then Result := Shell_NotifyIcon(NIM_ADD, @IconData);
  544. end;
  545. function TbsTrayIcon.HideIcon: Boolean;
  546. begin
  547.   Result := False;
  548.   if not SettingPreview then FIconVisible := False;
  549.   if (csDesigning in ComponentState)
  550.   then
  551.     begin
  552.       if SettingPreview and InitIcon
  553.       then Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
  554.     end
  555.   else
  556.     if InitIcon then Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
  557. end;
  558. function TbsTrayIcon.ModifyIcon: Boolean;
  559. begin
  560.   Result := False;
  561.   if InitIcon then Result := Shell_NotifyIcon(NIM_MODIFY, @IconData);
  562. end;
  563. procedure TbsTrayIcon.TimerCycle(Sender: TObject);
  564. begin
  565.   if Assigned(FIconList)
  566.   then
  567.     begin
  568.       FIconList.GetIcon(FIconIndex, FIcon);
  569.       CycleIcon;
  570.       ModifyIcon;
  571.       if FIconIndex < FIconList.Count-1
  572.       then
  573.         SetIconIndex(FIconIndex+1)
  574.       else
  575.         SetIconIndex(0);
  576.     end;
  577. end;
  578. function TbsTrayIcon.BitmapToIcon(const Bitmap: TBitmap;
  579.   const Icon: TIcon; MaskColor: TColor): Boolean;
  580. var
  581.   BitmapImageList: TImageList;
  582. begin
  583.   BitmapImageList := TImageList.CreateSize(16, 16);
  584.   try
  585.     Result := False;
  586.     BitmapImageList.AddMasked(Bitmap, MaskColor);
  587.     BitmapImageList.GetIcon(0, Icon);
  588.     Result := True;
  589.   finally
  590.     BitmapImageList.Free;
  591.   end;
  592. end;
  593. function TbsTrayIcon.Refresh: Boolean;
  594. begin
  595.   Result := ModifyIcon;
  596. end;
  597. procedure TbsTrayIcon.PopupAtCursor;
  598. var
  599.   CursorPos: TPoint;
  600. begin
  601.   if Assigned(PopupMenu)
  602.   then
  603.     if PopupMenu.AutoPopup
  604.     then
  605.       if GetCursorPos(CursorPos)
  606.       then
  607.         begin
  608.           Application.ProcessMessages;
  609.           SetForegroundWindow(Handle);
  610.           if Owner is TWinControl then
  611.            SetForegroundWindow((Owner as TWinControl).Handle);
  612.           PopupMenu.PopupComponent := Self;
  613.           PopupMenu.Popup(CursorPos.X, CursorPos.Y);
  614.           if Owner is TWinControl then
  615.           PostMessage((Owner as TWinControl).Handle, WM_NULL, 0, 0);
  616.         end;
  617. end;
  618. procedure TbsTrayIcon.Click;
  619. begin
  620.   if Assigned(FOnClick) then FOnClick(Self);
  621. end;
  622. procedure TbsTrayIcon.DblClick;
  623. begin
  624.   if Assigned(FOnDblClick) then FOnDblClick(Self);
  625. end;
  626. procedure TbsTrayIcon.MouseDown(Button: TMouseButton; Shift: TShiftState;
  627.   X, Y: Integer);
  628. begin
  629.   if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X, Y);
  630. end;
  631. procedure TbsTrayIcon.MouseUp(Button: TMouseButton; Shift: TShiftState;
  632.   X, Y: Integer);
  633. begin
  634.   if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, X, Y);
  635. end;
  636. procedure TbsTrayIcon.MouseMove(Shift: TShiftState; X, Y: Integer);
  637. begin
  638.   if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, X, Y);
  639. end;
  640. procedure TbsTrayIcon.CycleIcon;
  641. var
  642.   NextIconIndex: Integer;
  643. begin
  644.   NextIconIndex := 0;
  645.   if FIconList <> nil then
  646.     if FIconIndex < FIconList.Count then
  647.       NextIconIndex := FIconIndex +1;
  648.   if Assigned(FOnCycle) then
  649.     FOnCycle(Self, NextIconIndex);
  650. end;
  651. procedure TbsTrayIcon.DoMinimizeToTray;
  652. begin
  653.   HideMainForm;
  654.   IconVisible := True;
  655. end;
  656. procedure TbsTrayIcon.TimerClick(Sender: TObject);
  657. begin
  658.   ClickTimer.Enabled := False;
  659.   if (not IsDblClick)
  660.   then
  661.     if FClickReady
  662.     then
  663.       begin
  664.         FClickReady := False;
  665.         Click;
  666.       end;
  667.   IsDblClick := False;
  668. end;
  669. procedure TbsTrayIcon.ShowMainForm;
  670. begin
  671.   if Owner is TWinControl then
  672.     if Application.MainForm <> nil
  673.     then
  674.       begin
  675.         ShowWindow(Application.Handle, SW_RESTORE);
  676.         Application.MainForm.Visible := True;
  677.         if Application.MainForm.WindowState = wsMinimized
  678.         then Application.MainForm.WindowState := wsNormal;
  679.       end;
  680. end;
  681. procedure TbsTrayIcon.HideMainForm;
  682. begin
  683.   if Owner is TWinControl
  684.   then
  685.     if Application.MainForm <> nil
  686.     then
  687.       begin
  688.         Application.MainForm.Visible := False;
  689.         ShowWindow(Application.Handle, SW_HIDE);
  690.       end;
  691. end;
  692. function TbsTrayIcon.ShowBalloonHint;
  693. const
  694.   aBalloonIconTypes: array[TbsBalloonHintIcon] of Byte =
  695.     (NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR);
  696. begin
  697.   HideBalloonHint;
  698.   with IconData do
  699.   begin
  700.     uFlags := uFlags or NIF_INFO;
  701.     StrLCopy(szInfo, PChar(Text), SizeOf(szInfo)-1);
  702.     StrLCopy(szInfoTitle, PChar(Title), SizeOf(szInfoTitle)-1);
  703.     dwInfoFlags := aBalloonIconTypes[IconType];
  704.   end;
  705.   Result := ModifyIcon;
  706.   with IconData do
  707.     uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
  708. end;
  709. function TbsTrayIcon.HideBalloonHint: Boolean;
  710. begin
  711.   with IconData do
  712.   begin
  713.     uFlags := uFlags or NIF_INFO;
  714.     StrPCopy(szInfo, '');
  715.   end;
  716.   Result := ModifyIcon;
  717. end;
  718. end.