领略TApplicationEvents的风采

这是它的声明，它的数据成员全部都是Event，而没有真正意义上的数据（如此一来，几乎可以猜测，它本身什么都做不了）：

  TCustomApplicationEvents = class(TComponent)
  private
    FOnActionExecute: TActionEvent;
    FOnActionUpdate: TActionEvent;
    FOnException: TExceptionEvent;
    FOnMessage: TMessageEvent;
    FOnHelp: THelpEvent;
    FOnHint: TNotifyEvent;
    FOnIdle: TIdleEvent;
    FOnDeactivate: TNotifyEvent;
    FOnActivate: TNotifyEvent;
    FOnMinimize: TNotifyEvent;
    FOnRestore: TNotifyEvent;
    FOnShortCut: TShortCutEvent;
    FOnShowHint: TShowHintEvent;
    FOnSettingChange: TSettingChangeEvent;
    FOnModalBegin: TNotifyEvent;
    FOnModalEnd: TNotifyEvent;
    procedure DoActionExecute(Action: TBasicAction; var Handled: Boolean);
    procedure DoActionUpdate(Action: TBasicAction; var Handled: Boolean);
    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 DoShortcut(var Msg: TWMKey; var Handled: Boolean);
    procedure DoSettingChange(Sender: TObject; Flag: Integer; const Section: string; var Result: Longint);
    procedure DoModalBegin(Sender: TObject);
    procedure DoModalEnd(Sender: TObject);
  protected
    property OnActionExecute: TActionEvent read FOnActionExecute write FOnActionExecute;
    property OnActionUpdate: TActionEvent read FOnActionUpdate write FOnActionUpdate;
    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 OnRestore: TNotifyEvent read FOnRestore write FOnRestore;
    property OnShowHint: TShowHintEvent read FOnShowHint write FOnShowHint;
    property OnShortCut: TShortCutEvent read FOnShortCut write FOnShortCut;
    property OnSettingChange: TSettingChangeEvent read FOnSettingChange write FOnSettingChange;
    property OnModalBegin: TNotifyEvent read FOnModalBegin write FOnModalBegin;
    property OnModalEnd: TNotifyEvent read FOnModalEnd write FOnModalEnd;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Activate;
    procedure CancelDispatch;
  end;

它的构造函数平淡无奇：

constructor TCustomApplicationEvents.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if Assigned(MultiCaster) then
    MultiCaster.AddAppEvent(Self);
end;

procedure TMultiCaster.AddAppEvent(AppEvent: TCustomApplicationEvents);
begin
  if FAppEvents.IndexOf(AppEvent) = - then
    FAppEvents.Add(AppEvent);
end;

它的秘密在于：一旦使用了这个控件，那么就会引入AppEvents单元，因此会执行：

initialization
  GroupDescendentsWith(TCustomApplicationEvents, Controls.TControl);
  MultiCaster := TMultiCaster.Create(Application);
end.

其中GroupDescendentsWith函数来自classes.pas单元：

procedure GroupDescendentsWith(AClass, AClassGroup: TPersistentClass);
begin
  RegGroups.Lock;
  try
    RegGroups.GroupWith(AClass, AClassGroup);
  finally
    RegGroups.Unlock;
  end;
end;

而MultiCaster是AppEvents.pas的全局变量：

var
  MultiCaster: TMultiCaster = nil;

其实就是靠创建MultiCaster的时候进行对接：

constructor TMultiCaster.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAppEvents := TComponentList.Create(False);
  with Application do
  begin
    OnActionExecute := DoActionExecute;
    OnActionUpdate := DoActionUpdate;
    OnActivate := DoActivate;
    OnDeactivate := DoDeactivate;
    OnException := DoException;
    OnHelp := DoHelp;
    OnHint := DoHint;
    OnIdle := DoIdle;
    OnMessage := DoMessage;
    OnMinimize := DoMinimize;
    OnRestore := DoRestore;
    OnShowHint := DoShowHint;
    OnShortCut := DoShortcut;
    OnSettingChange := DoSettingChange;
    OnModalBegin := DoModalBegin;
    OnModalEnd := DoModalEnd;
  end;
end;

它对消息的处理就是转发，这里举三个例子（OnMessage，OnMinimize，OnException）：

procedure TCustomApplicationEvents.DoMessage(var Msg: TMsg; var Handled: Boolean);
begin
  if Assigned(FOnMessage) then FOnMessage(Msg, Handled);
end;

procedure TMultiCaster.DoMessage(var Msg: TMsg; var Handled: Boolean);
var
  I: Integer;
begin
  BeginDispatch;
  try
    for I := Count -  downto  do
    begin
      AppEvents[I].DoMessage(Msg, Handled);
      if FCancelDispatching then Break;
    end;
  finally
    EndDispatch;
  end;
end;

procedure TCustomApplicationEvents.DoMinimize(Sender: TObject);
begin
  if Assigned(FOnMinimize) then FOnMinimize(Sender);
end;

procedure TMultiCaster.DoMinimize(Sender: TObject);
var
  I: Integer;
begin
  BeginDispatch;
  try
    for I := Count -  downto  do
    begin
      AppEvents[I].DoMinimize(Sender);
      if FCancelDispatching then Break;
    end;
  finally
    EndDispatch;
  end;
end;

procedure TCustomApplicationEvents.DoException(Sender: TObject;
  E: Exception);
begin
  if not (E is EAbort) and Assigned(FOnException) then
    FOnException(Sender, E)
end;

procedure TMultiCaster.DoException(Sender: TObject; E: Exception);
var
  I: Integer;
  FExceptionHandled: Boolean;
begin
  BeginDispatch;
  FExceptionHandled := False;
  try
    for I := Count -  downto  do
    begin
      if Assigned(AppEvents[I].OnException) then
      begin
        FExceptionHandled := True;
        AppEvents[I].DoException(Sender, E);
        if FCancelDispatching then Break;
      end;
    end;
  finally
    if not FExceptionHandled then
      if not (E is EAbort) then
        Application.ShowException(E);
    EndDispatch;
  end;
end;

其实就是这么简单，这个AppEvents.pas单元连finalization模块都没有。。。

不过说真的，这个控件简单实用，在看它的析构函数的时候，我忽然有点明白了，为什么TApplication要处理这么多消息，原本它应该没有机会处理的嘛：

destructor TMultiCaster.Destroy;
begin
  MultiCaster := nil;
  with Application do
  begin
    OnActionExecute := nil;
    OnActionUpdate := nil;
    OnActivate := nil;
    OnDeactivate := nil;
    OnException := nil;
    OnHelp := nil;
    OnHint := nil;
    OnIdle := nil;
    OnMessage := nil;
    OnMinimize := nil;
    OnRestore := nil;
    OnShowHint := nil;
    OnShortCut := nil;
    OnSettingChange := nil;
    OnModalBegin := nil;
    OnModalEnd := nil;
  end;
  FAppEvents.Free;
  inherited Destroy;
end;

最后还发现，TApplicationEvents终于也不甘示弱，终于自己处理了一个消息，这可真是不容易呀。但是我搞不明白，为什么会有这里例外，而且在TMultiCaster里同样有定义：

procedure TCustomApplicationEvents.DoHint(Sender: TObject);
begin
  if Assigned(FOnHint) then
    FOnHint(Sender)
  else
    with THintAction.Create(Self) do
    try
      Hint := Application.Hint;
      Execute;
    finally
      Free;
    end;
end;

procedure TMultiCaster.DoHint(Sender: TObject);
var
  I: Integer;
begin
  BeginDispatch;
  try
    for I := Count -  downto  do
    begin
      AppEvents[I].DoHint(Sender);
      if FCancelDispatching then Break;
    end;
  finally
    EndDispatch;
  end;
end;