appevnts.pas

这是不可多得的源代码

  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;

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

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

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

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

procedure TMultiCaster.DoException(Sender: TObject; E: Exception);
var
  I: Integer;
  FExceptionHandled: Boolean;
begin
  BeginDispatch;
  FExceptionHandled := False;
  try
    for I := Count - 1 downto 0 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;

function TMultiCaster.DoHelp(Command: Word; Data: Integer; var CallHelp: Boolean): Boolean;
var
  I: Integer;
begin
  BeginDispatch;
  try
    Result := False;
    for I := Count - 1 downto 0 do
    begin
      Result := Result or AppEvents[I].DoHelp(Command, Data, CallHelp);
      if FCancelDispatching then Break;
    end;
  finally
    EndDispatch;
  end;
end;

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

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

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

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

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

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

procedure TMultiCaster.DoShowHint(var HintStr: string;
  var CanShow: Boolean; var HintInfo: THintInfo);
var
  I: Integer;
begin
  BeginDispatch;
  try
    for I := Count - 1 downto 0 do
    begin
      AppEvents[I].DoShowHint(HintStr, CanShow, HintInfo);
      if FCancelDispatching then Break;
    end;
  finally
    EndDispatch;
  end;
end;

procedure TMultiCaster.DoSettingChange(Sender: TObject;
  Flag: Integer; const Section: string; var Result: Longint);
var
  I: Integer;
begin
  BeginDispatch;
  try
    for I := Count - 1 downto 0 do
    begin
      AppEvents[I].DoSettingChange(Sender, Flag, Section, Result);
      if FCancelDispatching then Break;
    end;
  finally
    EndDispatch;
  end;
end;

procedure TMultiCaster.EndDispatch;
begin
  if FDispatching > 0 then
  begin
    Dec(FDispatching);
    FCancelDispatching := False;
    if (FDispatching = 0) and (FCacheAppEvent <> nil) and
      (FAppEvents.IndexOf(FCacheAppEvent) < FAppEvents.Count - 1) then
    begin
      FAppEvents.Remove(FCacheAppEvent);
      FAppEvents.Add(FCacheAppEvent);
      FCacheAppEvent := nil;
    end;
  end;
end;

function TMultiCaster.GetAppEvents(Index: Integer): TCustomApplicationEvents;
begin
  Result := TCustomApplicationEvents(FAppEvents[Index]);
end;

function TMultiCaster.GetCount: Integer;
begin
  Result := FAppEvents.Count;
end;

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

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

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