home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / APPEVENT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  26.8 KB  |  889 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11.  
  12.  
  13. unit AppEvent;
  14.  
  15. {$C PRELOAD}
  16. {$I RX.INC}
  17.  
  18. interface
  19.  
  20. uses SysUtils, {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  21.   Messages, Classes, Graphics, Controls, Forms
  22.   {$IFDEF RX_D4}, ActnList {$ENDIF};
  23.  
  24. const
  25. {$IFDEF WIN32}
  26.   DefHintColor = clInfoBk;
  27.   DefHintPause = 500;
  28.   DefHintShortPause = DefHintPause div 10;
  29.   DefHintHidePause = DefHintPause * 5;
  30. {$ELSE}
  31.   DefHintColor = $80FFFF;
  32.   DefHintPause = 800;
  33. {$ENDIF}
  34.  
  35. { TAppEvents }
  36.  
  37. type
  38.   TAppEvents = class(TComponent)
  39.   private
  40.     { Private declarations }
  41.     FChained: Boolean;
  42.     FHintColor: TColor;
  43.     FHintPause: Integer;
  44.     FShowHint: Boolean;
  45.     FCanvas: TCanvas;
  46.     FUpdateFormatSettings: Boolean;
  47. {$IFDEF WIN32}
  48.     FHintShortPause: Integer;
  49.     FHintHidePause: Integer;
  50.     FShowMainForm: Boolean;
  51. {$ENDIF}
  52. {$IFDEF RX_D3}
  53.     FUpdateMetricSettings: Boolean;
  54. {$ENDIF}
  55. {$IFDEF RX_D4}
  56.     FHintShortCuts: Boolean;
  57.     FBiDiMode: TBiDiMode;
  58.     FMouseDragImmediate: Boolean;
  59.     FMouseDragThreshold: Integer;
  60.     FOnActionExecute: TActionEvent;
  61.     FOnActionUpdate: TActionEvent;
  62.     FOnShortCut: TShortCutEvent;
  63. {$ENDIF}
  64. {$IFDEF RX_D5}
  65.     FBiDiKeyboard: string;
  66.     FNonBiDiKeyboard: string; 
  67. {$ENDIF}
  68.     FOnPaintIcon: TNotifyEvent;
  69.     FOnActivate: TNotifyEvent;
  70.     FOnDeactivate: TNotifyEvent;
  71.     FOnException: TExceptionEvent;
  72.     FOnIdle: TIdleEvent;
  73.     FOnHelp: THelpEvent;
  74.     FOnHint: TNotifyEvent;
  75.     FOnMessage: TMessageEvent;
  76.     FOnMinimize: TNotifyEvent;
  77.     FOnRestore: TNotifyEvent;
  78.     FOnShowHint: TShowHintEvent;
  79.     FOnSettingsChanged: TNotifyEvent;
  80.     FOnActiveControlChange: TNotifyEvent;
  81.     FOnActiveFormChange: TNotifyEvent;
  82.     procedure UpdateAppProps;
  83.     function GetCanvas: TCanvas;
  84.     function GetHintColor: TColor;
  85.     function GetHintPause: Integer;
  86.     function GetShowHint: Boolean;
  87.     procedure SetHintColor(Value: TColor);
  88.     procedure SetHintPause(Value: Integer);
  89.     procedure SetShowHint(Value: Boolean);
  90.     function GetUpdateFormatSettings: Boolean;
  91.     procedure SetUpdateFormatSettings(Value: Boolean);
  92. {$IFDEF WIN32}
  93.     function GetHintShortPause: Integer;
  94.     function GetHintHidePause: Integer;
  95.     function GetShowMainForm: Boolean;
  96.     procedure SetHintShortPause(Value: Integer);
  97.     procedure SetHintHidePause(Value: Integer);
  98.     procedure SetShowMainForm(Value: Boolean);
  99. {$ENDIF WIN32}
  100. {$IFDEF RX_D3}
  101.     function GetUpdateMetricSettings: Boolean;
  102.     procedure SetUpdateMetricSettings(Value: Boolean);
  103. {$ENDIF}
  104. {$IFDEF RX_D4}
  105.     function GetHintShortCuts: Boolean;
  106.     function GetBiDiMode: TBiDiMode;
  107.     procedure SetHintShortCuts(Value: Boolean);
  108.     procedure SetBiDiMode(Value: TBiDiMode);
  109.     function GetMouseDragImmediate: Boolean;
  110.     function GetMouseDragThreshold: Integer;
  111.     procedure SetMouseDragImmediate(Value: Boolean);
  112.     procedure SetMouseDragThreshold(Value: Integer);
  113. {$ENDIF}
  114. {$IFDEF RX_D5}
  115.     function GetBiDiKeyboard: string;
  116.     function GetNonBiDiKeyboard: string; 
  117.     procedure SetBiDiKeyboard(const Value: string);
  118.     procedure SetNonBiDiKeyboard(const Value: string);
  119. {$ENDIF}
  120.   protected
  121.     procedure Loaded; override;
  122.     procedure PaintIcon; virtual;
  123.     procedure SettingsChanged; dynamic;
  124.     function MessageHook(var Msg: TMessage): Boolean; virtual;
  125.   public
  126.     constructor Create(AOwner: TComponent); override;
  127.     destructor Destroy; override;
  128.     property Canvas: TCanvas read GetCanvas; { for painting the icon }
  129.   published
  130.     property Chained: Boolean read FChained write FChained default True;
  131.     property HintColor: TColor read GetHintColor write SetHintColor default DefHintColor;
  132.     property HintPause: Integer read GetHintPause write SetHintPause default DefHintPause;
  133.     property ShowHint: Boolean read GetShowHint write SetShowHint default True;
  134.     property UpdateFormatSettings: Boolean read GetUpdateFormatSettings
  135.       write SetUpdateFormatSettings default True;
  136. {$IFDEF WIN32}
  137.     property HintShortPause: Integer read GetHintShortPause write SetHintShortPause
  138.       default DefHintShortPause;
  139.     property HintHidePause: Integer read GetHintHidePause write SetHintHidePause
  140.       default DefHintHidePause;
  141.     property ShowMainForm: Boolean read GetShowMainForm write SetShowMainForm
  142.       default True;
  143. {$ENDIF}
  144. {$IFDEF RX_D3}
  145.     property UpdateMetricSettings: Boolean read GetUpdateMetricSettings
  146.       write SetUpdateMetricSettings default True;
  147. {$ENDIF}
  148. {$IFDEF RX_D4}
  149.     property HintShortCuts: Boolean read GetHintShortCuts write SetHintShortCuts
  150.       default True;
  151.     property BiDiMode: TBiDiMode read GetBiDiMode write SetBiDiMode
  152.       default bdLeftToRight;
  153.     property MouseDragImmediate: Boolean read GetMouseDragImmediate
  154.       write SetMouseDragImmediate default True;
  155.     property MouseDragThreshold: Integer read GetMouseDragThreshold
  156.       write SetMouseDragThreshold default 5;
  157.     property OnActionExecute: TActionEvent read FOnActionExecute write FOnActionExecute;
  158.     property OnActionUpdate: TActionEvent read FOnActionUpdate write FOnActionUpdate;
  159.     property OnShortCut: TShortCutEvent read FOnShortCut write FOnShortCut;
  160. {$ENDIF}
  161. {$IFDEF RX_D5}
  162.     property BiDiKeyboard: string read GetBiDiKeyboard write SetBiDiKeyboard;
  163.     property NonBiDiKeyboard: string read GetNonBiDiKeyboard write SetNonBiDiKeyboard; 
  164. {$ENDIF}
  165.     property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
  166.     property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
  167.     property OnException: TExceptionEvent read FOnException write FOnException;
  168.     property OnIdle: TIdleEvent read FOnIdle write FOnIdle;
  169.     property OnHelp: THelpEvent read FOnHelp write FOnHelp;
  170.     property OnHint: TNotifyEvent read FOnHint write FOnHint;
  171.     property OnMessage: TMessageEvent read FOnMessage write FOnMessage;
  172.     property OnMinimize: TNotifyEvent read FOnMinimize write FOnMinimize;
  173.     property OnPaintIcon: TNotifyEvent read FOnPaintIcon write FOnPaintIcon;
  174.     property OnRestore: TNotifyEvent read FOnRestore write FOnRestore;
  175.     property OnShowHint: TShowHintEvent read FOnShowHint write FOnShowHint;
  176.     property OnSettingsChanged: TNotifyEvent read FOnSettingsChanged write FOnSettingsChanged;
  177.     property OnActiveControlChange: TNotifyEvent read FOnActiveControlChange write FOnActiveControlChange;
  178.     property OnActiveFormChange: TNotifyEvent read FOnActiveFormChange write FOnActiveFormChange;
  179.   end;
  180.  
  181. implementation
  182.  
  183. uses AppUtils, VclUtils;
  184.  
  185. { TAppEventList }
  186.  
  187. type
  188.   TAppEventList = class(TObject)
  189.   private
  190.     FAppEvents: TList;
  191.     FHooked: Boolean;
  192.     FOnActivate: TNotifyEvent;
  193.     FOnDeactivate: TNotifyEvent;
  194.     FOnException: TExceptionEvent;
  195.     FOnIdle: TIdleEvent;
  196.     FOnHelp: THelpEvent;
  197.     FOnHint: TNotifyEvent;
  198.     FOnMessage: TMessageEvent;
  199.     FOnMinimize: TNotifyEvent;
  200.     FOnRestore: TNotifyEvent;
  201.     FOnShowHint: TShowHintEvent;
  202.     FOnActiveControlChange: TNotifyEvent;
  203.     FOnActiveFormChange: TNotifyEvent;
  204. {$IFDEF RX_D4}
  205.     FOnActionExecute: TActionEvent;
  206.     FOnActionUpdate: TActionEvent;
  207.     FOnShortCut: TShortCutEvent;
  208. {$ENDIF}
  209.     procedure AddEvents(App: TAppEvents);
  210.     procedure RemoveEvents(App: TAppEvents);
  211.     procedure ClearEvents;
  212.   protected
  213.     procedure DoActivate(Sender: TObject);
  214.     procedure DoDeactivate(Sender: TObject);
  215.     procedure DoException(Sender: TObject; E: Exception);
  216.     procedure DoIdle(Sender: TObject; var Done: Boolean);
  217.     function DoHelp(Command: Word; Data: Longint;
  218.       var CallHelp: Boolean): Boolean;
  219.     procedure DoHint(Sender: TObject);
  220.     procedure DoMessage(var Msg: TMsg; var Handled: Boolean);
  221.     procedure DoMinimize(Sender: TObject);
  222.     procedure DoRestore(Sender: TObject);
  223.     procedure DoShowHint(var HintStr: string; var CanShow: Boolean;
  224.       var HintInfo: THintInfo);
  225.     procedure DoActiveControlChange(Sender: TObject);
  226.     procedure DoActiveFormChange(Sender: TObject);
  227. {$IFDEF RX_D4}
  228.     procedure DoActionExecute(Action: TBasicAction; var Handled: Boolean);
  229.     procedure DoActionUpdate(Action: TBasicAction; var Handled: Boolean);
  230.     procedure DoShortCut(var Msg: TWMKey; var Handled: Boolean);
  231. {$ENDIF}
  232.   public
  233.     constructor Create;
  234.     destructor Destroy; override;
  235.   end;
  236.  
  237. constructor TAppEventList.Create;
  238. begin
  239.   inherited Create;
  240.   FAppEvents := TList.Create;
  241. end;
  242.  
  243. destructor TAppEventList.Destroy;
  244. begin
  245.   ClearEvents;
  246.   FAppEvents.Free;
  247.   inherited Destroy;
  248. end;
  249.  
  250. procedure TAppEventList.ClearEvents;
  251. begin
  252.   if FHooked then begin
  253.     Application.OnActivate := nil;
  254.     Application.OnDeactivate := nil;
  255.     Application.OnException := nil;
  256.     Application.OnIdle := nil;
  257.     Application.OnHelp := nil;
  258.     Application.OnHint := nil;
  259.     Application.OnMessage := nil;
  260.     Application.OnMinimize := nil;
  261.     Application.OnRestore := nil;
  262.     Application.OnShowHint := nil;
  263. {$IFDEF RX_D4}
  264.     Application.OnActionExecute := nil;
  265.     Application.OnActionUpdate := nil;
  266.     Application.OnShortCut := nil;
  267. {$ENDIF}
  268.     if Screen <> nil then begin
  269.       Screen.OnActiveControlChange := nil;
  270.       Screen.OnActiveFormChange := nil;
  271.     end;
  272.   end;
  273. end;
  274.  
  275. procedure TAppEventList.AddEvents(App: TAppEvents);
  276. begin
  277.   if (App <> nil) and (FAppEvents.IndexOf(App) = -1) then begin
  278.     FAppEvents.Add(App);
  279.     if not (csDesigning in App.ComponentState) and (FAppEvents.Count = 1) then
  280.     begin
  281.       FOnActivate := Application.OnActivate;
  282.       FOnDeactivate := Application.OnDeactivate;
  283.       FOnException := Application.OnException;
  284.       FOnIdle := Application.OnIdle;
  285.       FOnHelp := Application.OnHelp;
  286.       FOnHint := Application.OnHint;
  287.       FOnMessage := Application.OnMessage;
  288.       FOnMinimize := Application.OnMinimize;
  289.       FOnRestore := Application.OnRestore;
  290.       FOnShowHint := Application.OnShowHint;
  291. {$IFDEF RX_D4}
  292.       FOnActionExecute := Application.OnActionExecute;
  293.       FOnActionUpdate := Application.OnActionUpdate;
  294.       FOnShortCut := Application.OnShortCut;
  295.       Application.OnActionExecute := DoActionExecute;
  296.       Application.OnActionUpdate := DoActionUpdate;
  297.       Application.OnShortCut := DoShortCut;
  298. {$ENDIF}
  299.       Application.OnActivate := DoActivate;
  300.       Application.OnDeactivate := DoDeactivate;
  301.       Application.OnException := DoException;
  302.       Application.OnIdle := DoIdle;
  303.       Application.OnHelp := DoHelp;
  304.       Application.OnHint := DoHint;
  305.       Application.OnMessage := DoMessage;
  306.       Application.OnMinimize := DoMinimize;
  307.       Application.OnRestore := DoRestore;
  308.       Application.OnShowHint := DoShowHint;
  309.       if Screen <> nil then begin
  310.         FOnActiveControlChange := Screen.OnActiveControlChange;
  311.         FOnActiveFormChange := Screen.OnActiveFormChange;
  312.         Screen.OnActiveControlChange := DoActiveControlChange;
  313.         Screen.OnActiveFormChange := DoActiveFormChange;
  314.       end;
  315.       FHooked := True;
  316.     end;
  317.   end;
  318. end;
  319.  
  320. procedure TAppEventList.RemoveEvents(App: TAppEvents);
  321. begin
  322.   if FAppEvents.IndexOf(App) >= 0 then FAppEvents.Remove(App);
  323.   if not (csDesigning in App.ComponentState) and (FAppEvents.Count = 0) then
  324.     ClearEvents;
  325. end;
  326.  
  327. procedure TAppEventList.DoActivate(Sender: TObject);
  328. var
  329.   I: Integer;
  330. begin
  331.   for I := FAppEvents.Count - 1 downto 0 do begin
  332.     if Assigned(TAppEvents(FAppEvents[I]).FOnActivate) then
  333.       TAppEvents(FAppEvents[I]).FOnActivate(Sender);
  334.     if not TAppEvents(FAppEvents[I]).Chained then Exit;
  335.   end;
  336.   if Assigned(FOnActivate) then FOnActivate(Sender);
  337. end;
  338.  
  339. procedure TAppEventList.DoDeactivate(Sender: TObject);
  340. var
  341.   I: Integer;
  342. begin
  343.   for I := FAppEvents.Count - 1 downto 0 do begin
  344.     if Assigned(TAppEvents(FAppEvents[I]).FOnDeactivate) then
  345.       TAppEvents(FAppEvents[I]).FOnDeactivate(Sender);
  346.     if not TAppEvents(FAppEvents[I]).Chained then Exit;
  347.   end;
  348.   if Assigned(FOnDeactivate) then FOnDeactivate(Sender);
  349. end;
  350.  
  351. procedure TAppEventList.DoException(Sender: TObject; E: Exception);
  352. var
  353.   I: Integer;
  354.   Handled: Boolean;
  355. begin
  356.   Handled := False;
  357.   for I := FAppEvents.Count - 1 downto 0 do begin
  358.     if Assigned(TAppEvents(FAppEvents[I]).FOnException) then begin
  359.       TAppEvents(FAppEvents[I]).FOnException(Sender, E);
  360.       Handled := True;
  361.     end;
  362.     if not TAppEvents(FAppEvents[I]).Chained then begin
  363.       if not Handled then Application.ShowException(E);
  364.       Exit;
  365.     end;
  366.   end;
  367.   if Assigned(FOnException) then begin
  368.     FOnException(Sender, E);
  369.     Handled := True;
  370.   end;
  371.   if not Handled then Application.ShowException(E);
  372. end;
  373.  
  374. procedure TAppEventList.DoIdle(Sender: TObject; var Done: Boolean);
  375. var
  376.   I: Integer;
  377. begin
  378.   for I := FAppEvents.Count - 1 downto 0 do begin
  379.     if Assigned(TAppEvents(FAppEvents[I]).FOnIdle) then
  380.       TAppEvents(FAppEvents[I]).FOnIdle(Sender, Done);
  381.     if not TAppEvents(FAppEvents[I]).Chained then Exit;
  382.   end;
  383.   if Assigned(FOnIdle) then FOnIdle(Sender, Done);
  384. end;
  385.  
  386. function TAppEventList.DoHelp(Command: Word; Data: Longint;
  387.   var CallHelp: Boolean): Boolean;
  388. var
  389.   I: Integer;
  390. begin
  391.   Result := False;
  392.   for I := FAppEvents.Count - 1 downto 0 do begin
  393.     if Assigned(TAppEvents(FAppEvents[I]).FOnHelp) then
  394.       Result := TAppEvents(FAppEvents[I]).FOnHelp(Command, Data, CallHelp);
  395.     if not TAppEvents(FAppEvents[I]).Chained then Exit;
  396.   end;
  397.   if Assigned(FOnHelp) then Result := FOnHelp(Command, Data, CallHelp);
  398. end;
  399.  
  400. procedure TAppEventList.DoHint(Sender: TObject);
  401. var
  402.   I: Integer;
  403. begin
  404.   for I := FAppEvents.Count - 1 downto 0 do begin
  405.     if Assigned(TAppEvents(FAppEvents[I]).FOnHint) then
  406.       TAppEvents(FAppEvents[I]).FOnHint(Sender);
  407.     if not TAppEvents(FAppEvents[I]).Chained then Exit;
  408.   end;
  409.   if Assigned(FOnHint) then FOnHint(Sender);
  410. end;
  411.  
  412. procedure TAppEventList.DoMessage(var Msg: TMsg; var Handled: Boolean);
  413. var
  414.   I: Integer;
  415. begin
  416.   for I := FAppEvents.Count - 1 downto 0 do begin
  417.     if Assigned(TAppEvents(FAppEvents[I]).FOnMessage) then
  418.       TAppEvents(FAppEvents[I]).FOnMessage(Msg, Handled);
  419.     if not TAppEvents(FAppEvents[I]).Chained or Handled then Exit;
  420.   end;
  421.   if Assigned(FOnMessage) then FOnMessage(Msg, Handled);
  422. end;
  423.  
  424. procedure TAppEventList.DoMinimize(Sender: TObject);
  425. var
  426.   I: Integer;
  427. begin
  428.   for I := FAppEvents.Count - 1 downto 0 do begin
  429.     if Assigned(TAppEvents(FAppEvents[I]).FOnMinimize) then
  430.       TAppEvents(FAppEvents[I]).FOnMinimize(Sender);
  431.     if not TAppEvents(FAppEvents[I]).Chained then Exit;
  432.   end;
  433.   if Assigned(FOnMinimize) then FOnMinimize(Sender);
  434. end;
  435.  
  436. procedure TAppEventList.DoRestore(Sender: TObject);
  437. var
  438.   I: Integer;
  439. begin
  440.   for I := FAppEvents.Count - 1 downto 0 do begin
  441.     if Assigned(TAppEvents(FAppEvents[I]).FOnRestore) then
  442.       TAppEvents(FAppEvents[I]).FOnRestore(Sender);
  443.     if not TAppEvents(FAppEvents[I]).Chained then Exit;
  444.   end;
  445.   if Assigned(FOnRestore) then FOnRestore(Sender);
  446. end;
  447.  
  448. procedure TAppEventList.DoShowHint(var HintStr: string; var CanShow: Boolean;
  449.   var HintInfo: THintInfo);
  450. var
  451.   I: Integer;
  452. begin
  453.   for I := FAppEvents.Count - 1 downto 0 do begin
  454.     if Assigned(TAppEvents(FAppEvents[I]).FOnShowHint) then
  455.       TAppEvents(FAppEvents[I]).FOnShowHint(HintStr, CanShow, HintInfo);
  456.     if not TAppEvents(FAppEvents[I]).Chained then Exit;
  457.   end;
  458.   if Assigned(FOnShowHint) then FOnShowHint(HintStr, CanShow, HintInfo);
  459. end;
  460.  
  461. procedure TAppEventList.DoActiveControlChange(Sender: TObject);
  462. var
  463.   I: Integer;
  464. begin
  465.   for I := FAppEvents.Count - 1 downto 0 do begin
  466.     if Assigned(TAppEvents(FAppEvents[I]).FOnActiveControlChange) then
  467.       TAppEvents(FAppEvents[I]).FOnActiveControlChange(Sender);
  468.     if not TAppEvents(FAppEvents[I]).Chained then Exit;
  469.   end;
  470.   if Assigned(FOnActiveControlChange) then FOnActiveControlChange(Sender);
  471. end;
  472.  
  473. procedure TAppEventList.DoActiveFormChange(Sender: TObject);
  474. var
  475.   I: Integer;
  476. begin
  477.   for I := FAppEvents.Count - 1 downto 0 do begin
  478.     if Assigned(TAppEvents(FAppEvents[I]).FOnActiveFormChange) then
  479.       TAppEvents(FAppEvents[I]).FOnActiveFormChange(Sender);
  480.     if not TAppEvents(FAppEvents[I]).Chained then Exit;
  481.   end;
  482.   if Assigned(FOnActiveFormChange) then FOnActiveFormChange(Sender);
  483. end;
  484.  
  485. {$IFDEF RX_D4}
  486.  
  487. procedure TAppEventList.DoActionExecute(Action: TBasicAction;
  488.   var Handled: Boolean);
  489. var
  490.   I: Integer;
  491. begin
  492.   for I := FAppEvents.Count - 1 downto 0 do begin
  493.     if Assigned(TAppEvents(FAppEvents[I]).FOnActionExecute) then
  494.       TAppEvents(FAppEvents[I]).FOnActionExecute(Action, Handled);
  495.     if not TAppEvents(FAppEvents[I]).Chained or Handled then Exit;
  496.   end;
  497.   if Assigned(FOnActionExecute) then FOnActionExecute(Action, Handled);
  498. end;
  499.  
  500. procedure TAppEventList.DoActionUpdate(Action: TBasicAction;
  501.   var Handled: Boolean);
  502. var
  503.   I: Integer;
  504. begin
  505.   for I := FAppEvents.Count - 1 downto 0 do begin
  506.     if Assigned(TAppEvents(FAppEvents[I]).FOnActionUpdate) then
  507.       TAppEvents(FAppEvents[I]).FOnActionUpdate(Action, Handled);
  508.     if not TAppEvents(FAppEvents[I]).Chained or Handled then Exit;
  509.   end;
  510.   if Assigned(FOnActionUpdate) then FOnActionUpdate(Action, Handled);
  511. end;
  512.  
  513. procedure TAppEventList.DoShortCut(var Msg: TWMKey; var Handled: Boolean);
  514. var
  515.   I: Integer;
  516. begin
  517.   for I := FAppEvents.Count - 1 downto 0 do begin
  518.     if Assigned(TAppEvents(FAppEvents[I]).FOnShortCut) then
  519.       TAppEvents(FAppEvents[I]).FOnShortCut(Msg, Handled);
  520.     if not TAppEvents(FAppEvents[I]).Chained or Handled then Exit;
  521.   end;
  522.   if Assigned(FOnShortCut) then FOnShortCut(Msg, Handled);
  523. end;
  524.  
  525. {$ENDIF RX_D4}
  526.  
  527. const
  528.   AppList: TAppEventList = nil;
  529.  
  530. { TAppEvents }
  531.  
  532. constructor TAppEvents.Create(AOwner: TComponent);
  533. begin
  534.   inherited Create(AOwner);
  535.   if AppList = nil then AppList := TAppEventList.Create;
  536.   FChained := True;
  537.   FHintColor := DefHintColor;
  538.   FHintPause := DefHintPause;
  539.   FShowHint := True;
  540. {$IFDEF RX_D3}
  541.   FUpdateMetricSettings := True;
  542. {$ENDIF}
  543. {$IFDEF WIN32}
  544.   FHintShortPause := DefHintShortPause;
  545.   FHintHidePause := DefHintHidePause;
  546.   FShowMainForm := True;
  547. {$ENDIF}
  548. {$IFDEF RX_D4}
  549.   FHintShortCuts := True;
  550.   FBiDiMode := bdLeftToRight;
  551.   FMouseDragImmediate := True;
  552.   FMouseDragThreshold := 5;
  553. {$ENDIF}
  554.   FUpdateFormatSettings := True;
  555.   if not (csDesigning in ComponentState) then
  556.     Application.HookMainWindow(MessageHook);
  557.   AppList.AddEvents(Self);
  558. end;
  559.  
  560. destructor TAppEvents.Destroy;
  561. begin
  562.   if not (csDesigning in ComponentState) then
  563.     Application.UnhookMainWindow(MessageHook);
  564.   if Self <> nil then AppList.RemoveEvents(Self);
  565.   FCanvas.Free;
  566.   inherited Destroy;
  567. end;
  568.  
  569. procedure TAppEvents.Loaded;
  570. begin
  571.   inherited Loaded;
  572.   UpdateAppProps;
  573. end;
  574.  
  575. function TAppEvents.GetCanvas: TCanvas;
  576. begin
  577.   if FCanvas = nil then FCanvas := TCanvas.Create;
  578.   Result := FCanvas;
  579. end;
  580.  
  581. procedure TAppEvents.PaintIcon;
  582. var
  583.   PS: TPaintStruct;
  584. begin
  585.   BeginPaint(Application.Handle, PS);
  586.   try
  587.     if FCanvas <> nil then FCanvas.Free;
  588.     FCanvas := TCanvas.Create;
  589.     try
  590.       Canvas.Handle := PS.hDC;
  591.       Canvas.Brush.Color := clBackground;
  592.       if PS.fErase then Canvas.FillRect(PS.rcPaint);
  593.       if Assigned(FOnPaintIcon) then FOnPaintIcon(Self);
  594.     finally
  595.       FCanvas.Free;
  596.       FCanvas := nil;
  597.     end;
  598.   finally
  599.     EndPaint(Application.Handle, PS);
  600.   end;
  601. end;
  602.  
  603. procedure TAppEvents.SettingsChanged;
  604. begin
  605.   if Assigned(FOnSettingsChanged) then FOnSettingsChanged(Self);
  606. end;
  607.  
  608. function TAppEvents.MessageHook(var Msg: TMessage): Boolean;
  609. begin
  610.   Result := False;
  611.   case Msg.Msg of
  612.     WM_WININICHANGE:
  613.       begin
  614. {$IFNDEF WIN32}
  615.         if UpdateFormatSettings then GetFormatSettings;
  616. {$ELSE}
  617.   {$IFNDEF RX_D3}
  618.         if Application.ShowHint then begin
  619.           Application.ShowHint := False;
  620.           Application.ShowHint := True;
  621.         end;
  622.   {$ENDIF}
  623. {$ENDIF}
  624.         try
  625.           SettingsChanged;
  626.         except
  627.           Application.HandleException(Self);
  628.         end;
  629.       end;
  630. {$IFNDEF WIN32}
  631.     WM_ENDSESSION: if WordBool(Msg.wParam) then Halt;
  632. {$ENDIF}
  633.     WM_PAINT:
  634.       if Assigned(FOnPaintIcon) and IsIconic(Application.Handle) then
  635.       begin
  636.         PaintIcon;
  637.         Result := True;
  638.       end;
  639.   end;
  640. end;
  641.  
  642. function TAppEvents.GetHintColor: TColor;
  643. begin
  644.   if (csDesigning in ComponentState) then Result := FHintColor
  645.   else Result := Application.HintColor;
  646. end;
  647.  
  648. function TAppEvents.GetHintPause: Integer;
  649. begin
  650.   if (csDesigning in ComponentState) then Result := FHintPause
  651.   else Result := Application.HintPause;
  652. end;
  653.  
  654. function TAppEvents.GetShowHint: Boolean;
  655. begin
  656.   if (csDesigning in ComponentState) then Result := FShowHint
  657.   else Result := Application.ShowHint;
  658. end;
  659.  
  660. procedure TAppEvents.SetHintColor(Value: TColor);
  661. begin
  662.   FHintColor := Value;
  663.   if not (csDesigning in ComponentState) then Application.HintColor := Value;
  664. end;
  665.  
  666. procedure TAppEvents.SetHintPause(Value: Integer);
  667. begin
  668.   FHintPause := Value;
  669.   if not (csDesigning in ComponentState) then Application.HintPause := Value;
  670. end;
  671.  
  672. procedure TAppEvents.SetShowHint(Value: Boolean);
  673. begin
  674.   FShowHint := Value;
  675.   if not (csDesigning in ComponentState) then Application.ShowHint := Value;
  676. end;
  677.  
  678. function TAppEvents.GetUpdateFormatSettings: Boolean;
  679. begin
  680. {$IFDEF WIN32}
  681.   if (csDesigning in ComponentState) then Result := FUpdateFormatSettings
  682.   else Result := Application.UpdateFormatSettings;
  683. {$ELSE}
  684.   Result := FUpdateFormatSettings;
  685. {$ENDIF}
  686. end;
  687.  
  688. procedure TAppEvents.SetUpdateFormatSettings(Value: Boolean);
  689. begin
  690.   FUpdateFormatSettings := Value;
  691. {$IFDEF WIN32}
  692.   if not (csDesigning in ComponentState) then
  693.     Application.UpdateFormatSettings := Value;
  694. {$ENDIF}
  695. end;
  696.  
  697. {$IFDEF WIN32}
  698.  
  699. function TAppEvents.GetHintShortPause: Integer;
  700. begin
  701.   if (csDesigning in ComponentState) then Result := FHintShortPause
  702.   else Result := Application.HintShortPause;
  703. end;
  704.  
  705. function TAppEvents.GetHintHidePause: Integer;
  706. begin
  707.   if (csDesigning in ComponentState) then Result := FHintHidePause
  708.   else Result := Application.HintHidePause;
  709. end;
  710.  
  711. function TAppEvents.GetShowMainForm: Boolean;
  712. begin
  713.   if (csDesigning in ComponentState) then Result := FShowMainForm
  714.   else Result := Application.ShowMainForm;
  715. end;
  716.  
  717. procedure TAppEvents.SetHintShortPause(Value: Integer);
  718. begin
  719.   FHintShortPause := Value;
  720.   if not (csDesigning in ComponentState) then Application.HintShortPause := Value;
  721. end;
  722.  
  723. procedure TAppEvents.SetHintHidePause(Value: Integer);
  724. begin
  725.   FHintHidePause := Value;
  726.   if not (csDesigning in ComponentState) then Application.HintHidePause := Value;
  727. end;
  728.  
  729. procedure TAppEvents.SetShowMainForm(Value: Boolean);
  730. begin
  731.   FShowMainForm := Value;
  732.   if not (csDesigning in ComponentState) then Application.ShowMainForm := Value;
  733. end;
  734.  
  735. {$ENDIF WIN32}
  736.  
  737. {$IFDEF RX_D3}
  738.  
  739. function TAppEvents.GetUpdateMetricSettings: Boolean;
  740. begin
  741.   if (csDesigning in ComponentState) then Result := FUpdateMetricSettings
  742.   else Result := Application.UpdateMetricSettings;
  743. end;
  744.  
  745. procedure TAppEvents.SetUpdateMetricSettings(Value: Boolean);
  746. begin
  747.   FUpdateMetricSettings := Value;
  748.   if not (csDesigning in ComponentState) then
  749.     Application.UpdateMetricSettings := Value;
  750. end;
  751.  
  752. {$ENDIF RX_D3}
  753.  
  754. {$IFDEF RX_D4}
  755.  
  756. function TAppEvents.GetHintShortCuts: Boolean;
  757. begin
  758.   if (csDesigning in ComponentState) then Result := FHintShortCuts
  759.   else Result := Application.HintShortCuts;
  760. end;
  761.  
  762. function TAppEvents.GetBiDiMode: TBiDiMode;
  763. begin
  764.   if (csDesigning in ComponentState) then Result := FBiDiMode
  765.   else Result := Application.BiDiMode;
  766. end;
  767.  
  768. function TAppEvents.GetMouseDragImmediate: Boolean;
  769. begin
  770.   if (csDesigning in ComponentState) or (Mouse = nil) then
  771.     Result := FMouseDragImmediate
  772.   else Result := Mouse.DragImmediate;
  773. end;
  774.  
  775. function TAppEvents.GetMouseDragThreshold: Integer;
  776. begin
  777.   if (csDesigning in ComponentState) or (Mouse = nil) then
  778.     Result := FMouseDragThreshold
  779.   else Result := Mouse.DragThreshold;
  780. end;
  781.  
  782. procedure TAppEvents.SetMouseDragImmediate(Value: Boolean);
  783. begin
  784.   FMouseDragImmediate := Value;
  785.   if not (csDesigning in ComponentState) and (Mouse <> nil) then
  786.     Mouse.DragImmediate := Value;
  787. end;
  788.  
  789. procedure TAppEvents.SetMouseDragThreshold(Value: Integer);
  790. begin
  791.   FMouseDragThreshold := Value;
  792.   if not (csDesigning in ComponentState) and (Mouse <> nil) then
  793.     Mouse.DragThreshold := Value;
  794. end;
  795.  
  796. procedure TAppEvents.SetHintShortCuts(Value: Boolean);
  797. begin
  798.   FHintShortCuts := Value;
  799.   if not (csDesigning in ComponentState) then
  800.     Application.HintShortCuts := Value;
  801. end;
  802.  
  803. procedure TAppEvents.SetBiDiMode(Value: TBiDiMode);
  804. begin
  805.   FBiDiMode := Value;
  806.   if not (csDesigning in ComponentState) then
  807.     Application.BiDiMode := Value;
  808. end;
  809.  
  810. {$ENDIF RX_D4}
  811.  
  812. {$IFDEF RX_D5}
  813.  
  814. function TAppEvents.GetBiDiKeyboard: string;
  815. begin
  816.   if (csDesigning in ComponentState) then Result := FBiDiKeyboard
  817.   else Result := Application.BiDiKeyboard;
  818. end;
  819.  
  820. function TAppEvents.GetNonBiDiKeyboard: string; 
  821. begin
  822.   if (csDesigning in ComponentState) then Result := FNonBiDiKeyboard
  823.   else Result := Application.NonBiDiKeyboard;
  824. end;
  825.  
  826. procedure TAppEvents.SetBiDiKeyboard(const Value: string);
  827. begin
  828.   FBiDiKeyboard := Value;
  829.   if not (csDesigning in ComponentState) then
  830.     Application.BiDiKeyboard := Value;
  831. end;
  832.  
  833. procedure TAppEvents.SetNonBiDiKeyboard(const Value: string);
  834. begin
  835.   FNonBiDiKeyboard := Value;
  836.   if not (csDesigning in ComponentState) then
  837.     Application.NonBiDiKeyboard := Value;
  838. end;
  839.  
  840. {$ENDIF RX_D5}
  841.  
  842. procedure TAppEvents.UpdateAppProps;
  843. begin
  844.   if not (csDesigning in ComponentState) then begin
  845.     with Application do begin
  846.       HintColor := FHintColor;
  847.       HintPause := FHintPause;
  848.       ShowHint := FShowHint;
  849. {$IFDEF WIN32}
  850.       HintShortPause := FHintShortPause;
  851.       HintHidePause := FHintHidePause;
  852.       ShowMainForm := FShowMainForm;
  853.       UpdateFormatSettings := FUpdateFormatSettings;
  854. {$ENDIF}
  855. {$IFDEF RX_D3}
  856.       UpdateMetricSettings := FUpdateMetricSettings;
  857. {$ENDIF}
  858. {$IFDEF RX_D4}
  859.       HintShortCuts := FHintShortCuts;
  860.       BiDiMode := FBiDiMode;
  861.       with Mouse do begin
  862.         DragImmediate := FMouseDragImmediate;
  863.         DragThreshold := FMouseDragThreshold;
  864.       end;
  865. {$ENDIF}
  866. {$IFDEF RX_D5}
  867.       BiDiKeyboard := FBiDiKeyboard;
  868.       NonBiDiKeyboard := FNonBiDiKeyboard;      
  869. {$ENDIF}
  870.     end;
  871.   end;
  872. end;
  873.  
  874. procedure DestroyLocals; far;
  875. begin
  876.   if AppList <> nil then begin
  877.     AppList.Free;
  878.     AppList := nil;
  879.   end;
  880. end;
  881.  
  882. initialization
  883. {$IFDEF WIN32}
  884. finalization
  885.   DestroyLocals;
  886. {$ELSE}
  887.   AddExitProc(DestroyLocals);
  888. {$ENDIF}
  889. end.