home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / RXSHELL.PAS < prev    next >
Pascal/Delphi Source File  |  1999-10-12  |  22KB  |  788 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1995, 1996 AO ROSNO             }
  6. {         Copyright (c) 1997 Master-Bank                }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. {.$DEFINE USE_TIMER}
  11. { - Use Windows timer instead thread to the animated TrayIcon }
  12.  
  13. {$IFNDEF WIN32}
  14.   {$DEFINE USE_TIMER}  { - Always use timer in 16-bit version }
  15. {$ENDIF}
  16.  
  17. unit RXShell;
  18.  
  19. {$I RX.INC}
  20. {$P+,W-,R-}
  21.  
  22. interface
  23.  
  24. uses {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF} Messages,
  25.   Classes, Graphics, SysUtils, Forms, Controls, Menus, ShellAPI,
  26.   {$IFDEF USE_TIMER} ExtCtrls, {$ENDIF} IcoList;
  27.  
  28. type
  29. {$IFNDEF WIN32}
  30.   PNotifyIconData = ^TNotifyIconData;
  31.   TNotifyIconData = record
  32.     cbSize: Longint;
  33.     Wnd: Longint;
  34.     uID: Longint;
  35.     uFlags: Longint;
  36.     uCallbackMessage: Longint;
  37.     hIcon: Longint;
  38.     szTip: array [0..63] of Char;
  39.   end;
  40. {$ENDIF}
  41.  
  42.   TMouseButtons = set of TMouseButton;
  43.  
  44. { TRxTrayIcon }
  45.  
  46.   TRxTrayIcon = class(TComponent)
  47.   private
  48.     FHandle: HWnd;
  49.     FActive: Boolean;
  50.     FAdded: Boolean;
  51.     FAnimated: Boolean;
  52.     FEnabled: Boolean;
  53.     FClicked: TMouseButtons;
  54.     FIconIndex: Integer;
  55.     FInterval: Word;
  56.     FIconData: TNotifyIconData;
  57.     FIcon: TIcon;
  58.     FIconList: TIconList;
  59. {$IFDEF USE_TIMER}
  60.     FTimer: TTimer;
  61. {$ELSE}
  62.     FTimer: TThread;
  63. {$ENDIF}
  64.     FHint: string;
  65.     FShowDesign: Boolean;
  66.     FPopupMenu: TPopupMenu;
  67.     FOnClick: TMouseEvent;
  68.     FOnDblClick: TNotifyEvent;
  69.     FOnMouseMove: TMouseMoveEvent;
  70.     FOnMouseDown: TMouseEvent;
  71.     FOnMouseUp: TMouseEvent;
  72.     procedure ChangeIcon;
  73. {$IFDEF USE_TIMER}
  74.     procedure Timer(Sender: TObject);
  75. {$ELSE}
  76.     procedure Timer;
  77. {$ENDIF}
  78.     procedure SendCancelMode;
  79.     function CheckMenuPopup(X, Y: Integer): Boolean;
  80.     function CheckDefaultMenuItem: Boolean;
  81.     procedure SetHint(const Value: string);
  82.     procedure SetIcon(Value: TIcon);
  83.     procedure SetIconList(Value: TIconList);
  84.     procedure SetPopupMenu(Value: TPopupMenu);
  85.     procedure Activate;
  86.     procedure Deactivate;
  87.     procedure SetActive(Value: Boolean);
  88.     function GetAnimated: Boolean;
  89.     procedure SetAnimated(Value: Boolean);
  90.     procedure SetShowDesign(Value: Boolean);
  91.     procedure SetInterval(Value: Word);
  92.     procedure IconChanged(Sender: TObject);
  93.     procedure WndProc(var Message: TMessage);
  94.     function GetActiveIcon: TIcon;
  95.   protected
  96.     procedure DblClick; dynamic;
  97.     procedure DoClick(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); dynamic;
  98.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); dynamic;
  99.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
  100.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); dynamic;
  101.     procedure Loaded; override;
  102.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  103.     procedure UpdateNotifyData; virtual;
  104.   public
  105.     constructor Create(AOwner: TComponent); override;
  106.     destructor Destroy; override;
  107.     procedure Hide;
  108.     procedure Show;
  109.     property Handle: HWnd read FHandle;
  110.   published
  111.     property Active: Boolean read FActive write SetActive default True;
  112.     property Enabled: Boolean read FEnabled write FEnabled default True;
  113.     property Hint: string read FHint write SetHint;
  114.     property Icon: TIcon read FIcon write SetIcon;
  115.     property Icons: TIconList read FIconList write SetIconList;
  116.     { Ensure Icons is declared before Animated }
  117.     property Animated: Boolean read GetAnimated write SetAnimated default False;
  118.     property Interval: Word read FInterval write SetInterval default 150;
  119.     property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
  120.     property ShowDesign: Boolean read FShowDesign write SetShowDesign stored False;
  121.     property OnClick: TMouseEvent read FOnClick write FOnClick;
  122.     property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
  123.     property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
  124.     property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
  125.     property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
  126.   end;
  127.  
  128. function IconExtract(const FileName: string; Id: Integer): TIcon;
  129. procedure WinAbout(const AppName, Stuff: string);
  130.  
  131. type
  132.   TExecState = (esNormal, esMinimized, esMaximized, esHidden);
  133.  
  134. function FileExecute(const FileName, Params, StartDir: string;
  135.   InitialState: TExecState): THandle;
  136. function FileExecuteWait(const FileName, Params, StartDir: string;
  137.   InitialState: TExecState): Integer;
  138.  
  139. implementation
  140.  
  141. uses RxConst, RxCConst, VCLUtils, MaxMin;
  142.  
  143. {$IFNDEF WIN32}
  144. const
  145.   Shell = 'shell';
  146.  
  147. function ExtractAssociatedIcon(hInst: THandle; lpIconPath: PChar;
  148.   var lpiIcon: Word): HIcon; far; external Shell;
  149. function ShellAbout(Wnd: HWnd; App, Stuff: PChar; Icon: HIcon): Integer;
  150.   far; external Shell;
  151. {$ENDIF WIN32}
  152.  
  153. procedure WinAbout(const AppName, Stuff: string);
  154. var
  155. {$IFNDEF WIN32}
  156.   szApp, szStuff: array[0..255] of Char;
  157. {$ENDIF}
  158.   Wnd: HWnd;
  159.   Icon: HIcon;
  160. begin
  161.   if Application.MainForm <> nil then Wnd := Application.MainForm.Handle
  162.   else Wnd := 0;
  163.   Icon := Application.Icon.Handle;
  164.   if Icon = 0 then Icon := LoadIcon(0, IDI_APPLICATION);
  165. {$IFDEF WIN32}
  166.   ShellAbout(Wnd, PChar(AppName), PChar(Stuff), Icon);
  167. {$ELSE}
  168.   StrPLCopy(szApp, AppName, SizeOf(szApp) - 1);
  169.   StrPLCopy(szStuff, Stuff, SizeOf(szStuff) - 1);
  170.   ShellAbout(Wnd, szApp, szStuff, Icon);
  171. {$ENDIF}
  172. end;
  173.  
  174. function IconExtract(const FileName: string; Id: Integer): TIcon;
  175. var
  176.   S: array[0..255] of char;
  177.   IconHandle: HIcon;
  178.   Index: Word;
  179. begin
  180.   Result := TIcon.Create;
  181.   try
  182.     StrPLCopy(S, FileName, SizeOf(S) - 1);
  183.     IconHandle := ExtractIcon(hInstance, S, Id);
  184.     if IconHandle < 2 then begin
  185.       Index := Id;
  186.       IconHandle := ExtractAssociatedIcon(hInstance, S, Index);
  187.     end;
  188.     if IconHandle < 2 then begin
  189.       if IconHandle = 1 then
  190.         raise EResNotFound.Create(LoadStr(SFileNotExec))
  191.       else begin
  192.         Result.Free;
  193.         Result := nil;
  194.       end;
  195.     end else Result.Handle := IconHandle;
  196.   except
  197.     Result.Free;
  198.     raise;
  199.   end;
  200. end;
  201.  
  202. const
  203.   ShowCommands: array[TExecState] of Integer =
  204.     (SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED, SW_HIDE);
  205.  
  206. function FileExecute(const FileName, Params, StartDir: string;
  207.   InitialState: TExecState): THandle;
  208. {$IFDEF WIN32}
  209. begin
  210.   Result := ShellExecute(Application.Handle, nil, PChar(FileName),
  211.     PChar(Params), PChar(StartDir), ShowCommands[InitialState]);
  212. end;
  213. {$ELSE}
  214. var
  215.   cFileName, cParams, cPath: array [0..80] of Char;
  216. begin
  217.   Result := ShellExecute(Application.Handle, nil, StrPCopy(cFileName,
  218.     FileName), StrPCopy(cParams, Params), StrPCopy(cPath, StartDir),
  219.     ShowCommands[InitialState]);
  220. end;
  221. {$ENDIF}
  222.  
  223. function FileExecuteWait(const FileName, Params, StartDir: string;
  224.   InitialState: TExecState): Integer;
  225. {$IFDEF WIN32}
  226. var
  227.   Info: TShellExecuteInfo;
  228.   ExitCode: DWORD;
  229. begin
  230.   FillChar(Info, SizeOf(Info), 0);
  231.   Info.cbSize := SizeOf(TShellExecuteInfo);
  232.   with Info do begin
  233.     fMask := SEE_MASK_NOCLOSEPROCESS;
  234.     Wnd := Application.Handle;
  235.     lpFile := PChar(FileName);
  236.     lpParameters := PChar(Params);
  237.     lpDirectory := PChar(StartDir);
  238.     nShow := ShowCommands[InitialState];
  239.   end;
  240.   if ShellExecuteEx(@Info) then begin
  241.     repeat
  242.       Application.ProcessMessages;
  243.       GetExitCodeProcess(Info.hProcess, ExitCode);
  244.     until (ExitCode <> STILL_ACTIVE) or Application.Terminated;
  245.     Result := ExitCode;
  246.   end
  247.   else Result := -1;
  248. end;
  249. {$ELSE}
  250. var
  251.   Task: THandle;
  252. begin
  253.   Result := 0;
  254.   Task := FileExecute(FileName, Params, StartDir, InitialState);
  255.   if Task >= HINSTANCE_ERROR then begin
  256.     repeat
  257.       Application.ProcessMessages;
  258.     until (GetModuleUsage(Task) = 0) or Application.Terminated;
  259.   end
  260.   else Result := -1;
  261. end;
  262. {$ENDIF}
  263.  
  264. {$IFNDEF USE_TIMER}
  265.  
  266. { TTimerThread }
  267.  
  268. type
  269.   TTimerThread = class(TThread)
  270.   private
  271.     FOwnerTray: TRxTrayIcon;
  272.   protected
  273.     procedure Execute; override;
  274.   public
  275.     constructor Create(TrayIcon: TRxTrayIcon; CreateSuspended: Boolean);
  276.   end;
  277.  
  278. constructor TTimerThread.Create(TrayIcon: TRxTrayIcon; CreateSuspended: Boolean);
  279. begin
  280.   FOwnerTray := TrayIcon;
  281.   inherited Create(CreateSuspended);
  282.   FreeOnTerminate := True;
  283. end;
  284.  
  285. procedure TTimerThread.Execute;
  286.  
  287.   function ThreadClosed: Boolean;
  288.   begin
  289.     Result := Terminated or Application.Terminated or (FOwnerTray = nil);
  290.   end;
  291.  
  292. begin
  293.   while not Terminated do begin
  294.     if not ThreadClosed then
  295.       if SleepEx(FOwnerTray.FInterval, False) = 0 then begin
  296.         if not ThreadClosed and FOwnerTray.Animated then
  297.           FOwnerTray.Timer;
  298.       end;
  299.   end;
  300. end;
  301.  
  302. {$ENDIF USE_TIMER}
  303.  
  304. {$IFNDEF WIN32}
  305.  
  306. type
  307.   TLoadLibrary32 = function (FileName: PChar; Handle, Special: Longint): Longint;
  308.   TFreeLibrary32 = function (Handle: Longint): Bool;
  309.   TGetAddress32 = function (Handle: Longint; ProcName: PChar): Pointer;
  310.   TCallProc32 = function (Msg: Longint; Data: PNotifyIconData; ProcHandle: Pointer;
  311.     AddressConvert, Params: Longint): Longint;
  312.  
  313. const
  314.   NIM_ADD     = $00000000;
  315.   NIM_MODIFY  = $00000001;
  316.   NIM_DELETE  = $00000002;
  317.  
  318.   NIF_MESSAGE = $00000001;
  319.   NIF_ICON    = $00000002;
  320.   NIF_TIP     = $00000004;
  321.  
  322. const
  323.   Shell32: Longint = 0;
  324.   ProcAddr: Pointer = nil;
  325.   FreeLib32: TFreeLibrary32 = nil;
  326.   CallPrc32: TCallProc32 = nil;
  327.  
  328. procedure FreeHandles; far;
  329. begin
  330.   if (ProcAddr <> nil) and Assigned(FreeLib32) then FreeLib32(Shell32);
  331. end;
  332.  
  333. procedure InitHandles;
  334. var
  335.   Kernel16: THandle;
  336.   LoadLib32: TLoadLibrary32;
  337.   GetAddr32: TGetAddress32;
  338. begin
  339.   Kernel16 := GetModuleHandle('kernel');
  340.   @LoadLib32 := GetProcAddress(Kernel16, 'LoadLibraryEx32W');
  341.   @FreeLib32 := GetProcAddress(Kernel16, 'FreeLibrary32W');
  342.   @GetAddr32 := GetProcAddress(Kernel16, 'GetProcAddress32W');
  343.   @CallPrc32 := GetProcAddress(Kernel16, 'CallProc32W');
  344.   if (@LoadLib32 <> nil) and (@FreeLib32 <> nil) and (@GetAddr32 <> nil)
  345.     and (@CallPrc32 <> nil) then
  346.   begin
  347.     Shell32 := LoadLib32('shell32', 0, 0);
  348.     if Shell32 >= HINSTANCE_ERROR then begin
  349.       ProcAddr := GetAddr32(Shell32, 'Shell_NotifyIcon');
  350.       if ProcAddr = nil then begin
  351.         FreeLib32(Shell32);
  352.         Shell32 := 1;
  353.       end
  354.       else AddExitProc(FreeHandles);
  355.     end
  356.     else Shell32 := 1;
  357.   end;
  358. end;
  359.  
  360. function Shell_NotifyIcon(dwMessage: Longint; lpData: PNotifyIconData): Bool;
  361. begin
  362.   if (ProcAddr = nil) and (Shell32 <> 1) then InitHandles;
  363.   if ProcAddr <> nil then
  364.     Result := Bool(CallPrc32(dwMessage, lpData, ProcAddr, $01, 2));
  365. end;
  366.  
  367. {$ENDIF WIN32}
  368.  
  369. { TRxTrayIcon }
  370.  
  371. constructor TRxTrayIcon.Create(AOwner: Tcomponent);
  372. begin
  373.   inherited Create(AOwner);
  374.   FHandle := AllocateHWnd(WndProc);
  375.   FIcon := TIcon.Create;
  376.   FIcon.OnChange := IconChanged;
  377.   FIconList := TIconList.Create;
  378.   FIconList.OnChange := IconChanged;
  379.   FIconIndex := -1;
  380.   FEnabled := True;
  381.   FInterval := 150;
  382.   FActive := True;
  383. end;
  384.  
  385. destructor TRxTrayIcon.Destroy;
  386. begin
  387.   Destroying;
  388.   FEnabled := False;
  389.   FIconList.OnChange := nil;
  390.   FIcon.OnChange := nil;
  391.   SetAnimated(False);
  392.   Deactivate;
  393.   DeallocateHWnd(FHandle);
  394.   FIcon.Free;
  395.   FIcon := nil;
  396.   FIconList.Free;
  397.   FIconList := nil;
  398.   inherited Destroy;
  399. end;
  400.  
  401. procedure TRxTrayIcon.Loaded;
  402. begin
  403.   inherited Loaded;
  404.   if FActive and not (csDesigning in ComponentState) then Activate;
  405. end;
  406.  
  407. procedure TRxTrayIcon.Notification(AComponent: TComponent;
  408.   Operation: TOperation);
  409. begin
  410.   inherited Notification(AComponent, Operation);
  411.   if (AComponent = PopupMenu) and (Operation = opRemove) then
  412.     PopupMenu := nil;
  413. end;
  414.  
  415. procedure TRxTrayIcon.SetPopupMenu(Value: TPopupMenu);
  416. begin
  417.   FPopupMenu := Value;
  418. {$IFDEF WIN32}
  419.   if Value <> nil then Value.FreeNotification(Self);
  420. {$ENDIF}
  421. end;
  422.  
  423. procedure TRxTrayIcon.SendCancelMode;
  424. var
  425.   F: TForm;
  426. begin
  427.   if not (csDestroying in ComponentState) then begin
  428.     F := Screen.ActiveForm;
  429.     if F = nil then F := Application.MainForm;
  430.     if F <> nil then F.SendCancelMode(nil);
  431.   end;
  432. end;
  433.  
  434. function TRxTrayIcon.CheckMenuPopup(X, Y: Integer): Boolean;
  435. begin
  436.   Result := False;
  437.   if not (csDesigning in ComponentState) and Active and
  438.     (PopupMenu <> nil) and PopupMenu.AutoPopup then
  439.   begin
  440.     PopupMenu.PopupComponent := Self;
  441.     SendCancelMode;
  442.     SwitchToWindow(FHandle, False);
  443.     Application.ProcessMessages;
  444.     try
  445.       PopupMenu.Popup(X, Y);
  446.     finally
  447. {$IFDEF WIN32}
  448.       SwitchToWindow(FHandle, False);
  449. {$ENDIF}
  450.     end;
  451.     Result := True;
  452.   end;
  453. end;
  454.  
  455. function TRxTrayIcon.CheckDefaultMenuItem: Boolean;
  456. {$IFDEF WIN32}
  457. var
  458.   Item: TMenuItem;
  459.   I: Integer;
  460. {$ENDIF}
  461. begin
  462.   Result := False;
  463. {$IFDEF WIN32}
  464.   if not (csDesigning in ComponentState) and Active and
  465.     (PopupMenu <> nil) and (PopupMenu.Items <> nil) then
  466.   begin
  467.     I := 0;
  468.     while (I < PopupMenu.Items.Count) do begin
  469.       Item := PopupMenu.Items[I];
  470.       if Item.Default and Item.Enabled then begin
  471.         Item.Click;
  472.         Result := True;
  473.         Break;
  474.       end;
  475.       Inc(I);
  476.     end;
  477.   end;
  478. {$ENDIF}
  479. end;
  480.  
  481. procedure TRxTrayIcon.SetIcon(Value: TIcon);
  482. begin
  483.   FIcon.Assign(Value);
  484. end;
  485.  
  486. procedure TRxTrayIcon.SetIconList(Value: TIconList);
  487. begin
  488.   FIconList.Assign(Value);
  489. end;
  490.  
  491. function TRxTrayIcon.GetActiveIcon: TIcon;
  492. begin
  493.   Result := FIcon;
  494.   if (FIconList <> nil) and (FIconList.Count > 0) and Animated then
  495.     Result := FIconList[Max(Min(FIconIndex, FIconList.Count - 1), 0)];
  496. end;
  497.  
  498. function TRxTrayIcon.GetAnimated: Boolean;
  499. begin
  500.   Result := FAnimated;
  501. end;
  502.  
  503. procedure TRxTrayIcon.SetAnimated(Value: Boolean);
  504. begin
  505.   Value := Value and Assigned(FIconList) and (FIconList.Count > 0);
  506.   if Value <> Animated then begin
  507.     if Value then begin
  508. {$IFDEF USE_TIMER}
  509.       FTimer := TTimer.Create(Self);
  510.       FTimer.Enabled := FAdded;
  511.       FTimer.Interval := FInterval;
  512.       FTimer.OnTimer := Timer;
  513. {$ELSE}
  514.       FTimer := TTimerThread.Create(Self, not FAdded);
  515. {$ENDIF}
  516.       FAnimated := True;
  517.     end
  518.     else begin
  519.       FAnimated := False;
  520. {$IFDEF USE_TIMER}
  521.       FTimer.Free;
  522.       FTimer := nil;
  523. {$ELSE}
  524.       TTimerThread(FTimer).FOwnerTray := nil;
  525.       while FTimer.Suspended do FTimer.Resume;
  526.       FTimer.Terminate;
  527. {$ENDIF}
  528.     end;
  529.     FIconIndex := 0;
  530.     ChangeIcon;
  531.   end;
  532. end;
  533.  
  534. procedure TRxTrayIcon.SetActive(Value: Boolean);
  535. begin
  536.   if (Value <> FActive) then begin
  537.     FActive := Value;
  538.     if not (csDesigning in ComponentState) then
  539.       if Value then Activate else Deactivate;
  540.   end;
  541. end;
  542.  
  543. procedure TRxTrayIcon.Show;
  544. begin
  545.   Active := True;
  546. end;
  547.  
  548. procedure TRxTrayIcon.Hide;
  549. begin
  550.   Active := False;
  551. end;
  552.  
  553. procedure TRxTrayIcon.SetShowDesign(Value: Boolean);
  554. begin
  555.   if (csDesigning in ComponentState) then begin
  556.     if Value then Activate else Deactivate;
  557.     FShowDesign := FAdded;
  558.   end;
  559. end;
  560.  
  561. procedure TRxTrayIcon.SetInterval(Value: Word);
  562. begin
  563.   if FInterval <> Value then begin
  564.     FInterval := Value;
  565. {$IFDEF USE_TIMER}
  566.     if Animated then FTimer.Interval := FInterval;
  567. {$ENDIF}
  568.   end;
  569. end;
  570.  
  571. {$IFDEF USE_TIMER}
  572. procedure TRxTrayIcon.Timer(Sender: TObject);
  573. {$ELSE}
  574. procedure TRxTrayIcon.Timer;
  575. {$ENDIF}
  576. begin
  577.   if not (csDestroying in ComponentState) and Animated then begin
  578.     Inc(FIconIndex);
  579.     if (FIconList = nil) or (FIconIndex >= FIconList.Count) then
  580.       FIconIndex := 0;
  581.     ChangeIcon;
  582.   end;
  583. end;
  584.  
  585. procedure TRxTrayIcon.IconChanged(Sender: TObject);
  586. begin
  587.   ChangeIcon;
  588. end;
  589.  
  590. procedure TRxTrayIcon.SetHint(const Value: string);
  591. begin
  592.   if FHint <> Value then begin
  593.     FHint := Value;
  594.     ChangeIcon;
  595.   end;
  596. end;
  597.  
  598. procedure TRxTrayIcon.UpdateNotifyData;
  599. var
  600.   Ico: TIcon;
  601. begin
  602.   with FIconData do begin
  603.     cbSize := SizeOf(TNotifyIconData);
  604.     Wnd := FHandle;
  605.     uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  606.     Ico := GetActiveIcon;
  607.     if Ico <> nil then hIcon := Ico.Handle
  608. {$IFDEF WIN32}
  609.     else hIcon := INVALID_HANDLE_VALUE;
  610. {$ELSE}
  611.     else hIcon := 0;
  612. {$ENDIF}
  613.     StrPLCopy(szTip, GetShortHint(FHint), SizeOf(szTip) - 1);
  614.     uCallbackMessage := CM_TRAYICON;
  615.     uID := 0;
  616.   end;
  617. end;
  618.  
  619. procedure TRxTrayIcon.Activate;
  620. var
  621.   Ico: TIcon;
  622. begin
  623.   Deactivate;
  624.   Ico := GetActiveIcon;
  625.   if (Ico <> nil) and not Ico.Empty then begin
  626.     FClicked := [];
  627.     UpdateNotifyData;
  628.     FAdded := Shell_NotifyIcon(NIM_ADD, @FIconData);
  629.     if (GetShortHint(FHint) = '') and FAdded then
  630.       Shell_NotifyIcon(NIM_MODIFY, @FIconData);
  631. {$IFDEF USE_TIMER}
  632.     if Animated then FTimer.Enabled := True;
  633. {$ELSE}
  634.     if Animated then
  635.       while FTimer.Suspended do FTimer.Resume;
  636. {$ENDIF}
  637.   end;
  638. end;
  639.  
  640. procedure TRxTrayIcon.Deactivate;
  641. begin
  642.   Shell_NotifyIcon(NIM_DELETE, @FIconData);
  643.   FAdded := False;
  644.   FClicked := [];
  645. {$IFDEF USE_TIMER}
  646.   if Animated then FTimer.Enabled := False;
  647. {$ELSE}
  648.   if Animated and not FTimer.Suspended then FTimer.Suspend;
  649. {$ENDIF}
  650. end;
  651.  
  652. procedure TRxTrayIcon.ChangeIcon;
  653. var
  654.   Ico: TIcon;
  655. begin
  656.   if (FIconList = nil) or (FIconList.Count = 0) then SetAnimated(False);
  657.   if FAdded then begin
  658.     Ico := GetActiveIcon;
  659.     if (Ico <> nil) and not Ico.Empty then begin
  660.       UpdateNotifyData;
  661.       Shell_NotifyIcon(NIM_MODIFY, @FIconData);
  662.     end
  663.     else Deactivate;
  664.   end
  665.   else begin
  666.     if ((csDesigning in ComponentState) and FShowDesign) or
  667.       (not (csDesigning in ComponentState) and FActive) then Activate;
  668.   end;
  669. end;
  670.  
  671. procedure TRxTrayIcon.MouseMove(Shift: TShiftState; X, Y: Integer);
  672. begin
  673.   if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, X, Y);
  674. end;
  675.  
  676. procedure TRxTrayIcon.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  677. begin
  678.   if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X, Y);
  679. end;
  680.  
  681. procedure TRxTrayIcon.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  682. begin
  683.   if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, X, Y);
  684. end;
  685.  
  686. procedure TRxTrayIcon.DblClick;
  687. begin
  688.   if not CheckDefaultMenuItem and Assigned(FOnDblClick) then
  689.     FOnDblClick(Self);
  690. end;
  691.  
  692. procedure TRxTrayIcon.DoClick(Button: TMouseButton; Shift: TShiftState;
  693.   X, Y: Integer);
  694. begin
  695.   if (Button = mbRight) and CheckMenuPopup(X, Y) then Exit;
  696.   if Assigned(FOnClick) then FOnClick(Self, Button, Shift, X, Y);
  697. end;
  698.  
  699. procedure TRxTrayIcon.WndProc(var Message: TMessage);
  700.  
  701.   function GetShiftState: TShiftState;
  702.   begin
  703.     Result := [];
  704.     if GetKeyState(VK_SHIFT) < 0 then Include(Result, ssShift);
  705.     if GetKeyState(VK_CONTROL) < 0 then Include(Result, ssCtrl);
  706.     if GetKeyState(VK_MENU) < 0 then Include(Result, ssAlt);
  707.   end;
  708.  
  709. var
  710.   P: TPoint;
  711.   Shift: TShiftState;
  712. begin
  713.   try
  714.     with Message do
  715.       if (Msg = CM_TRAYICON) and Self.FEnabled then begin
  716.         case lParam of
  717.           WM_LBUTTONDBLCLK:
  718.             begin
  719.               DblClick;
  720.               GetCursorPos(P);
  721.               MouseDown(mbLeft, GetShiftState + [ssDouble], P.X, P.Y);
  722.             end;
  723.           WM_RBUTTONDBLCLK:
  724.             begin
  725.               GetCursorPos(P);
  726.               MouseDown(mbRight, GetShiftState + [ssDouble], P.X, P.Y);
  727.             end;
  728.           WM_MBUTTONDBLCLK:
  729.             begin
  730.               GetCursorPos(P);
  731.               MouseDown(mbMiddle, GetShiftState + [ssDouble], P.X, P.Y);
  732.             end;
  733.           WM_MOUSEMOVE:
  734.             begin
  735.               GetCursorPos(P);
  736.               MouseMove(GetShiftState, P.X, P.Y);
  737.             end;
  738.           WM_LBUTTONDOWN:
  739.             begin
  740.               GetCursorPos(P);
  741.               MouseDown(mbLeft, GetShiftState + [ssLeft], P.X, P.Y);
  742.               Include(FClicked, mbLeft);
  743.             end;
  744.           WM_LBUTTONUP:
  745.             begin
  746.               Shift := GetShiftState + [ssLeft];
  747.               GetCursorPos(P);
  748.               if mbLeft in FClicked then begin
  749.                 Exclude(FClicked, mbLeft);
  750.                 DoClick(mbLeft, Shift, P.X, P.Y);
  751.               end;
  752.               MouseUp(mbLeft, Shift, P.X, P.Y);
  753.             end;
  754.           WM_RBUTTONDOWN:
  755.             begin
  756.               GetCursorPos(P);
  757.               MouseDown(mbRight, GetShiftState + [ssRight], P.X, P.Y);
  758.               Include(FClicked, mbRight);
  759.             end;
  760.           WM_RBUTTONUP:
  761.             begin
  762.               Shift := GetShiftState + [ssRight];
  763.               GetCursorPos(P);
  764.               if mbRight in FClicked then begin
  765.                 Exclude(FClicked, mbRight);
  766.                 DoClick(mbRight, Shift, P.X, P.Y);
  767.               end;
  768.               MouseUp(mbRight, Shift, P.X, P.Y);
  769.             end;
  770.           WM_MBUTTONDOWN:
  771.             begin
  772.               GetCursorPos(P);
  773.               MouseDown(mbMiddle, GetShiftState + [ssMiddle], P.X, P.Y);
  774.             end;
  775.           WM_MBUTTONUP:
  776.             begin
  777.               GetCursorPos(P);
  778.               MouseUp(mbMiddle, GetShiftState + [ssMiddle], P.X, P.Y);
  779.             end;
  780.         end;
  781.       end
  782.       else Result := DefWindowProc(FHandle, Msg, wParam, lParam);
  783.   except
  784.     Application.HandleException(Self);
  785.   end;
  786. end;
  787.  
  788. end.