Предлагает ли Delphi обработчик событий для уведомлений о создании форм?

Question

Предоставляет ли Delphi какое-либо событие или ловушку для создания формы (или, в более общем смысле, события жизненного цикла формы)?

Таким образом, если где-то в коде создается и отображается форма (модальная или немодальная, динамически или на обычной стадии запуска приложения), Delphi вызывает обработчик событий, который позволяет регистрировать / анализировать / изменять форму перед ней. показано?

Я знаю, что есть варианты, которые включают введение базового класса формы или пользовательской процедуры создания формы, но для существующих приложений, которые уже имеют много форм, было бы «хорошо» иметь неинтрузивную опцию для добавления чего-то похожего на cross проблем в Аспектно-ориентированном программировании (АОП).

Например, если бы у меня был некоторый код для отслеживания статистики использования, который вводит дополнительные обработчики событий, я мог бы просто добавить эту функциональность для каждой формы, разработчикам не пришлось бы изменять код приложения, только добавьте код, подобный этому

...
   Application.OnNewForm := MyNewFormCreated;
...

procedure TMyApp.MyNewFormCreated(Sender: TCustomForm);
begin
  // iterate over components and do other stuff with the new form
  ...
end;

Answer 1

Во время выполнения вы можете переопределить методы TCustomForm.DoCreate и TCustomFrame.Create следующим образом:

type
  THookedForm = class(TCustomForm)
    procedure HookedDoCreate;
  end;

  THookedFrame = class(TCustomFrame)
    constructor Create(AOwner: TComponent); override;
  end;

var
  OriginalForm, OriginalFrame: TPatchCode;

procedure PatchCreate;
begin
  if OriginalForm[0]<>0 then
    exit; // patch once
  RedirectCode(@THookedForm.DoCreate,@THookedForm.HookedDoCreate,@OriginalForm);
  RedirectCode(@THookedFrame.Create,@THookedFrame.Create,@OriginalFrame);
end;


// hook logic was inspired from GetText()

{ THookedForm }

procedure THookedForm.HookedDoCreate;
// translate form contents just before an OnCreate handler would be called
begin
  try
  try
    if Language<>nil then begin
      DisableAlign;
      DisableAutoRange;
      try
        Language.FormTranslateOne(self); // translate form
      finally
        EnableAlign;
        EnableAutoRange;
      end;
    end;
  finally
    RedirectCodeRestore(@THookedForm.DoCreate,OriginalForm); // disable Hook
    try
      DoCreate;  // call normal DoCreate event
    finally
      RedirectCode(@THookedForm.DoCreate,@THookedForm.HookedDoCreate);
    end;
  end;
  except
    on Exception do; // ignore all raised exception
  end;
end;

{ THookedFrame }

constructor THookedFrame.Create(AOwner: TComponent);
// translate frame contents just after constructor has been called
begin
  RedirectCodeRestore(@THookedFrame.Create,OriginalFrame); // disable Hook
  try
    inherited Create(AOwner); // call normal constructor
  finally
    RedirectCode(@THookedFrame.Create,@THookedFrame.Create);
  end;
  if Language=nil then exit;
  DisableAlign;
  DisableAutoRange;
  try
    Language.FormTranslateOne(self); // translate frame
  finally
    EnableAlign;
    EnableAutoRange;
  end;
end;


....

initialization
  PatchCreate;

Следовательно, ваше собственное событие DoCreate будет вызываться при каждом создании экземпляра TForm.

Этот код извлечен из mORMoti18n.pas , и вы можете найти процедуры исправления (для Windows и Linux / BSD) в SynCommons.pas .

Answer 2

// Arnaud Bouchez provided great code, but he cut some important pieces of own code.
// And what is more important - he didn't try to run it even once before posting :)
// There is correct unit (copy-pasted from another project & tested with XE6/Win.x32)
// It works for Windows x32 and x64 platforms.

unit HookCreateFrm;

interface

implementation

uses
  Windows, Classes, Forms, IdGlobal, SysUtils;

type
  THookedForm = class(TCustomForm)
    procedure HookedDoCreate;
  end;

  THookedFrame = class(TCustomFrame)
    constructor Create(AOwner: TComponent); override;
  end;

  PPatchEvent = ^TPatchEvent;
  // asm opcode hack to patch an existing routine
  TPatchEvent = packed record
    Jump: byte;
    Offset: integer;
  end;

var
  PatchForm, OriginalForm: TPatchEvent;
  PatchPositionForm: PPatchEvent = nil;
  PatchFrame, OriginalFrame: TPatchEvent;
  PatchPositionFrame: PPatchEvent = nil;

procedure PatchCreate;
var ov: cardinal;
begin
  // hook TForm:
  PatchPositionForm := PPatchEvent(@THookedForm.DoCreate);
  OriginalForm := PatchPositionForm^;
  PatchForm.Jump := $E9; // Jmp opcode
  PatchForm.Offset := PByte(@THookedForm.HookedDoCreate)-PByte(PatchPositionForm)-5;
  if not VirtualProtect(PatchPositionForm, 5, PAGE_EXECUTE_READWRITE, @ov) then
    RaiseLastOSError;
  PatchPositionForm^ := PatchForm; // enable Hook
  // hook TFrame:
  PatchPositionFrame := PPatchEvent(@TCustomFrame.Create);
  OriginalFrame := PatchPositionFrame^;
  PatchFrame.Jump := $E9; // Jmp opcode
  PatchFrame.Offset := PByte(@THookedFrame.Create)-PByte(PatchPositionFrame)-5;
  if not VirtualProtect(PatchPositionFrame, 5, PAGE_EXECUTE_READWRITE, @ov) then
    RaiseLastOSError;
  PatchPositionFrame^ := PatchFrame; // enable Hook
end;

// hook logic was inspired from GetText()

{ THookedForm }

procedure THookedForm.HookedDoCreate;
begin

  // do what you want before original DoCreate

  PatchPositionForm^ := OriginalForm;
  try
    DoCreate;
  finally
    PatchPositionForm^ := PatchForm;
  end;

  // do what you want after original DoCreate

end;

{ THookedFrame }

constructor THookedFrame.Create(AOwner: TComponent);
begin

  // do what you want before original DoCreate

  PatchPositionFrame^ := OriginalFrame;
  try
    inherited Create(AOwner);
  finally
    PatchPositionFrame^ := PatchFrame;
  end;

  // do what you want after original Create

end;

initialization
  PatchCreate;

end.

Answer 3

Самым близким вариантом, который я могу себе представить на данный момент, который может удовлетворить ваши потребности, является событие Screen.OnActiveFormChange, которое запускается каждый раз, когда изменяется текущая активная форма.Но это может быть слишком поздно для ваших нужд.

Answer 4

Если обычная реализация, основанная на суперклассе, не подходит, лучше бы мне было слишком поздно, чем никогда отвечать: -)

• использовать структуру уведомлений .

Erik Sasse Проект Notification Service на Bitbucket является многообещающим. Вы можете получить это здесь . Он основан на TNotify .