{*******************************************************}
{                                                       }
{         Delphi VCL Extensions (RX)                    }
{                                                       }
{         Copyright (c) 1997, 1998 Master-Bank          }
{                                                       }
{*******************************************************}

unit AppEvent;

{$C PRELOAD}
{$I RX.INC}

interface

uses SysUtils, {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  Messages, Classes, Graphics, Controls, Forms
  {$IFDEF RX_D4}, ActnList {$ENDIF};

const
{$IFDEF WIN32}
  DefHintColor = clInfoBk;
  DefHintPause = 500;
  DefHintShortPause = DefHintPause div 10;
  DefHintHidePause = DefHintPause * 5;
{$ELSE}
  DefHintColor = $80FFFF;
  DefHintPause = 800;
{$ENDIF}

{ TAppEvents }

type
  TAppEvents = class(TComponent)
  private
    { Private declarations }
    FChained: Boolean;
    FHintColor: TColor;
    FHintPause: Integer;
    FShowHint: Boolean;
    FCanvas: TCanvas;
    FUpdateFormatSettings: Boolean;
{$IFDEF WIN32}
    FHintShortPause: Integer;
    FHintHidePause: Integer;
    FShowMainForm: Boolean;
{$ENDIF}
{$IFDEF RX_D3}
    FUpdateMetricSettings: Boolean;
{$ENDIF}
{$IFDEF RX_D4}
    FHintShortCuts: Boolean;
    FBiDiMode: TBiDiMode;
    FMouseDragImmediate: Boolean;
    FMouseDragThreshold: Integer;
    FOnActionExecute: TActionEvent;
    FOnActionUpdate: TActionEvent;
    FOnShortCut: TShortCutEvent;
{$ENDIF}
{$IFDEF RX_D5}
    FBiDiKeyboard: string;
    FNonBiDiKeyboard: string; 
{$ENDIF}
    FOnPaintIcon: TNotifyEvent;
    FOnActivate: TNotifyEvent;
    FOnDeactivate: TNotifyEvent;
    FOnException: TExceptionEvent;
    FOnIdle: TIdleEvent;
    FOnHelp: THelpEvent;
    FOnHint: TNotifyEvent;
    FOnMessage: TMessageEvent;
    FOnMinimize: TNotifyEvent;
    FOnRestore: TNotifyEvent;
    FOnShowHint: TShowHintEvent;
    FOnSettingsChanged: TNotifyEvent;
    FOnActiveControlChange: TNotifyEvent;
    FOnActiveFormChange: TNotifyEvent;
    procedure UpdateAppProps;
    function GetCanvas: TCanvas;
    function GetHintColor: TColor;
    function GetHintPause: Integer;
    function GetShowHint: Boolean;
    procedure SetHintColor(Value: TColor);
    procedure SetHintPause(Value: Integer);
    procedure SetShowHint(Value: Boolean);
    function GetUpdateFormatSettings: Boolean;
    procedure SetUpdateFormatSettings(Value: Boolean);
{$IFDEF WIN32}
    function GetHintShortPause: Integer;
    function GetHintHidePause: Integer;
    function GetShowMainForm: Boolean;
    procedure SetHintShortPause(Value: Integer);
    procedure SetHintHidePause(Value: Integer);
    procedure SetShowMainForm(Value: Boolean);
{$ENDIF WIN32}
{$IFDEF RX_D3}
    function GetUpdateMetricSettings: Boolean;
    procedure SetUpdateMetricSettings(Value: Boolean);
{$ENDIF}
{$IFDEF RX_D4}
    function GetHintShortCuts: Boolean;
    function GetBiDiMode: TBiDiMode;
    procedure SetHintShortCuts(Value: Boolean);
    procedure SetBiDiMode(Value: TBiDiMode);
    function GetMouseDragImmediate: Boolean;
    function GetMouseDragThreshold: Integer;
    procedure SetMouseDragImmediate(Value: Boolean);
    procedure SetMouseDragThreshold(Value: Integer);
{$ENDIF}
{$IFDEF RX_D5}
    function GetBiDiKeyboard: string;
    function GetNonBiDiKeyboard: string; 
    procedure SetBiDiKeyboard(const Value: string);
    procedure SetNonBiDiKeyboard(const Value: string);
{$ENDIF}
  protected
    procedure Loaded; override;
    procedure PaintIcon; virtual;
    procedure SettingsChanged; dynamic;
    function MessageHook(var Msg: TMessage): Boolean; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Canvas: TCanvas read GetCanvas; { for painting the icon }
  published
    property Chained: Boolean read FChained write FChained default True;
    property HintColor: TColor read GetHintColor write SetHintColor default DefHintColor;
    property HintPause: Integer read GetHintPause write SetHintPause default DefHintPause;
    property ShowHint: Boolean read GetShowHint write SetShowHint default True;
    property UpdateFormatSettings: Boolean read GetUpdateFormatSettings
      write SetUpdateFormatSettings default True;
{$IFDEF WIN32}
    property HintShortPause: Integer read GetHintShortPause write SetHintShortPause
      default DefHintShortPause;
    property HintHidePause: Integer read GetHintHidePause write SetHintHidePause
      default DefHintHidePause;
    property ShowMainForm: Boolean read GetShowMainForm write SetShowMainForm
      default True;
{$ENDIF}
{$IFDEF RX_D3}
    property UpdateMetricSettings: Boolean read GetUpdateMetricSettings
      write SetUpdateMetricSettings default True;
{$ENDIF}
{$IFDEF RX_D4}
    property HintShortCuts: Boolean read GetHintShortCuts write SetHintShortCuts
      default True;
    property BiDiMode: TBiDiMode read GetBiDiMode write SetBiDiMode
      default bdLeftToRight;
    property MouseDragImmediate: Boolean read GetMouseDragImmediate
      write SetMouseDragImmediate default True;
    property MouseDragThreshold: Integer read GetMouseDragThreshold
      write SetMouseDragThreshold default 5;
    property OnActionExecute: TActionEvent read FOnActionExecute write FOnActionExecute;
    property OnActionUpdate: TActionEvent read FOnActionUpdate write FOnActionUpdate;
    property OnShortCut: TShortCutEvent read FOnShortCut write FOnShortCut;
{$ENDIF}
{$IFDEF RX_D5}
    property BiDiKeyboard: string read GetBiDiKeyboard write SetBiDiKeyboard;
    property NonBiDiKeyboard: string read GetNonBiDiKeyboard write SetNonBiDiKeyboard; 
{$ENDIF}
    property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
    property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
    property OnException: TExceptionEvent read FOnException write FOnException;
    property OnIdle: TIdleEvent read FOnIdle write FOnIdle;
    property OnHelp: THelpEvent read FOnHelp write FOnHelp;
    property OnHint: TNotifyEvent read FOnHint write FOnHint;
    property OnMessage: TMessageEvent read FOnMessage write FOnMessage;
    property OnMinimize: TNotifyEvent read FOnMinimize write FOnMinimize;
    property OnPaintIcon: TNotifyEvent read FOnPaintIcon write FOnPaintIcon;
    property OnRestore: TNotifyEvent read FOnRestore write FOnRestore;
    property OnShowHint: TShowHintEvent read FOnShowHint write FOnShowHint;
    property OnSettingsChanged: TNotifyEvent read FOnSettingsChanged write FOnSettingsChanged;
    property OnActiveControlChange: TNotifyEvent read FOnActiveControlChange write FOnActiveControlChange;
    property OnActiveFormChange: TNotifyEvent read FOnActiveFormChange write FOnActiveFormChange;
  end;

implementation

uses AppUtils, VclUtils;

{ TAppEventList }

type
  TAppEventList = class(TObject)
  private
    FAppEvents: TList;
    FHooked: Boolean;
    FOnActivate: TNotifyEvent;
    FOnDeactivate: TNotifyEvent;
    FOnException: TExceptionEvent;
    FOnIdle: TIdleEvent;
    FOnHelp: THelpEvent;
    FOnHint: TNotifyEvent;
    FOnMessage: TMessageEvent;
    FOnMinimize: TNotifyEvent;
    FOnRestore: TNotifyEvent;
    FOnShowHint: TShowHintEvent;
    FOnActiveControlChange: TNotifyEvent;
    FOnActiveFormChange: TNotifyEvent;
{$IFDEF RX_D4}
    FOnActionExecute: TActionEvent;
    FOnActionUpdate: TActionEvent;
    FOnShortCut: TShortCutEvent;
{$ENDIF}
    procedure AddEvents(App: TAppEvents);
    procedure RemoveEvents(App: TAppEvents);
    procedure ClearEvents;
  protected
    procedure DoActivate(Sender: TObject);
    procedure DoDeactivate(Sender: TObject);
    procedure DoException(Sender: TObject; E: Exception);
    procedure DoIdle(Sender: TObject; var Done: Boolean);
    function DoHelp(Command: Word; Data: Longint;
      var CallHelp: Boolean): Boolean;
    procedure DoHint(Sender: TObject);
    procedure DoMessage(var Msg: TMsg; var Handled: Boolean);
    procedure DoMinimize(Sender: TObject);
    procedure DoRestore(Sender: TObject);
    procedure DoShowHint(var HintStr: string; var CanShow: Boolean;
      var HintInfo: THintInfo);
    procedure DoActiveControlChange(Sender: TObject);
    procedure DoActiveFormChange(Sender: TObject);
{$IFDEF RX_D4}
    procedure DoActionExecute(Action: TBasicAction; var Handled: Boolean);
    procedure DoActionUpdate(Action: TBasicAction; var Handled: Boolean);
    procedure DoShortCut(var Msg: TWMKey; var Handled: Boolean);
{$ENDIF}
  public
    constructor Create;
    destructor Destroy; override;
  end;

constructor TAppEventList.Create;
begin
  inherited Create;
  FAppEvents := TList.Create;
end;

destructor TAppEventList.Destroy;
begin
  ClearEvents;
  FAppEvents.Free;
  inherited Destroy;
end;

procedure TAppEventList.ClearEvents;
begin
  if FHooked then begin
    Application.OnActivate := nil;
    Application.OnDeactivate := nil;
    Application.OnException := nil;
    Application.OnIdle := nil;
    Application.OnHelp := nil;
    Application.OnHint := nil;
    Application.OnMessage := nil;
    Application.OnMinimize := nil;
    Application.OnRestore := nil;
    Application.OnShowHint := nil;
{$IFDEF RX_D4}
    Application.OnActionExecute := nil;
    Application.OnActionUpdate := nil;
    Application.OnShortCut := nil;
{$ENDIF}
    if Screen <> nil then begin
      Screen.OnActiveControlChange := nil;
      Screen.OnActiveFormChange := nil;
    end;
  end;
end;

procedure TAppEventList.AddEvents(App: TAppEvents);
begin
  if (App <> nil) and (FAppEvents.IndexOf(App) = -1) then begin
    FAppEvents.Add(App);
    if not (csDesigning in App.ComponentState) and (FAppEvents.Count = 1) then
    begin
      FOnActivate := Application.OnActivate;
      FOnDeactivate := Application.OnDeactivate;
      FOnException := Application.OnException;
      FOnIdle := Application.OnIdle;
      FOnHelp := Application.OnHelp;
      FOnHint := Application.OnHint;
      FOnMessage := Application.OnMessage;
      FOnMinimize := Application.OnMinimize;
      FOnRestore := Application.OnRestore;
      FOnShowHint := Application.OnShowHint;
{$IFDEF RX_D4}
      FOnActionExecute := Application.OnActionExecute;
      FOnActionUpdate := Application.OnActionUpdate;
      FOnShortCut := Application.OnShortCut;
      Application.OnActionExecute := DoActionExecute;
      Application.OnActionUpdate := DoActionUpdate;
      Application.OnShortCut := DoShortCut;
{$ENDIF}
      Application.OnActivate := DoActivate;
      Application.OnDeactivate := DoDeactivate;
      Application.OnException := DoException;
      Application.OnIdle := DoIdle;
      Application.OnHelp := DoHelp;
      Application.OnHint := DoHint;
      Application.OnMessage := DoMessage;
      Application.OnMinimize := DoMinimize;
      Application.OnRestore := DoRestore;
      Application.OnShowHint := DoShowHint;
      if Screen <> nil then begin
        FOnActiveControlChange := Screen.OnActiveControlChange;
        FOnActiveFormChange := Screen.OnActiveFormChange;
        Screen.OnActiveControlChange := DoActiveControlChange;
        Screen.OnActiveFormChange := DoActiveFormChange;
      end;
      FHooked := True;
    end;
  end;
end;

procedure TAppEventList.RemoveEvents(App: TAppEvents);
begin
  if FAppEvents.IndexOf(App) >= 0 then FAppEvents.Remove(App);
  if not (csDesigning in App.ComponentState) and (FAppEvents.Count = 0) then
    ClearEvents;
end;

procedure TAppEventList.DoActivate(Sender: TObject);
var
  I: Integer;
begin
  for I := FAppEvents.Count - 1 downto 0 do begin
    if Assigned(TAppEvents(FAppEvents[I]).FOnActivate) then
      TAppEvents(FAppEvents[I]).FOnActivate(Sender);
    if not TAppEvents(FAppEvents[I]).Chained then Exit;
  end;
  if Assigned(FOnActivate) then FOnActivate(Sender);
end;

procedure TAppEventList.DoDeactivate(Sender: TObject);
var
  I: Integer;
begin
  for I := FAppEvents.Count - 1 downto 0 do begin
    if Assigned(TAppEvents(FAppEvents[I]).FOnDeactivate) then
      TAppEvents(FAppEvents[I]).FOnDeactivate(Sender);
    if not TAppEvents(FAppEvents[I]).Chained then Exit;
  end;
  if Assigned(FOnDeactivate) then FOnDeactivate(Sender);
end;

procedure TAppEventList.DoException(Sender: TObject; E: Exception);
var
  I: Integer;
  Handled: Boolean;
begin
  Handled := False;
  for I := FAppEvents.Count - 1 downto 0 do begin
    if Assigned(TAppEvents(FAppEvents[I]).FOnException) then begin
      TAppEvents(FAppEvents[I]).FOnException(Sender, E);
      Handled := True;
    end;
    if not TAppEvents(FAppEvents[I]).Chained then begin
      if not Handled then Application.ShowException(E);
      Exit;
    end;
  end;
  if Assigned(FOnException) then begin
    FOnException(Sender, E);
    Handled := True;
  end;
  if not Handled then Application.ShowException(E);
end;

procedure TAppEventList.DoIdle(Sender: TObject; var Done: Boolean);
var
  I: Integer;
begin
  for I := FAppEvents.Count - 1 downto 0 do begin
    if Assigned(TAppEvents(FAppEvents[I]).FOnIdle) then
      TAppEvents(FAppEvents[I]).FOnIdle(Sender, Done);
    if not TAppEvents(FAppEvents[I]).Chained then Exit;
  end;
  if Assigned(FOnIdle) then FOnIdle(Sender, Done);
end;

function TAppEventList.DoHelp(Command: Word; Data: Longint;
  var CallHelp: Boolean): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := FAppEvents.Count - 1 downto 0 do begin
    if Assigned(TAppEvents(FAppEvents[I]).FOnHelp) then
      Result := TAppEvents(FAppEvents[I]).FOnHelp(Command, Data, CallHelp);
    if not TAppEvents(FAppEvents[I]).Chained then Exit;
  end;
  if Assigned(FOnHelp) then Result := FOnHelp(Command, Data, CallHelp);
end;

procedure TAppEventList.DoHint(Sender: TObject);
var
  I: Integer;
begin
  for I := FAppEvents.Count - 1 downto 0 do begin
    if Assigned(TAppEvents(FAppEvents[I]).FOnHint) then
      TAppEvents(FAppEvents[I]).FOnHint(Sender);
    if not TAppEvents(FAppEvents[I]).Chained then Exit;
  end;
  if Assigned(FOnHint) then FOnHint(Sender);
end;

procedure TAppEventList.DoMessage(var Msg: TMsg; var Handled: Boolean);
var
  I: Integer;
begin
  for I := FAppEvents.Count - 1 downto 0 do begin
    if Assigned(TAppEvents(FAppEvents[I]).FOnMessage) then
      TAppEvents(FAppEvents[I]).FOnMessage(Msg, Handled);
    if not TAppEvents(FAppEvents[I]).Chained or Handled then Exit;
  end;
  if Assigned(FOnMessage) then FOnMessage(Msg, Handled);
end;

procedure TAppEventList.DoMinimize(Sender: TObject);
var
  I: Integer;
begin
  for I := FAppEvents.Count - 1 downto 0 do begin
    if Assigned(TAppEvents(FAppEvents[I]).FOnMinimize) then
      TAppEvents(FAppEvents[I]).FOnMinimize(Sender);
    if not TAppEvents(FAppEvents[I]).Chained then Exit;
  end;
  if Assigned(FOnMinimize) then FOnMinimize(Sender);
end;

procedure TAppEventList.DoRestore(Sender: TObject);
var
  I: Integer;
begin
  for I := FAppEvents.Count - 1 downto 0 do begin
    if Assigned(TAppEvents(FAppEvents[I]).FOnRestore) then
      TAppEvents(FAppEvents[I]).FOnRestore(Sender);
    if not TAppEvents(FAppEvents[I]).Chained then Exit;
  end;
  if Assigned(FOnRestore) then FOnRestore(Sender);
end;