这是它的声明，它的数据成员全部都是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;