APPEVENT.PAS
Upload User: aomate168
Upload Date: 2021-08-05
Package Size: 826k
Code Size: 27k
Category:

Windows Develop

Development Platform:

C++ Builder

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