Guest User

RXShell.pas

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