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