Does Delphi offer an event handler for form creation notifications?

Question

Does Delphi provide some kind of event or hook for form creation (or more generally, form lifecycle events)?

So that if somewhere in the code a form is created and shown (modal or non-modal, dynamically or in the usual app starup stage), Delphi calls an event handler which allows to log / analyse / modify the form before it is shown?

I know there are options which involve introducing a base form class or a custom form creation procedure, but for existing applications which already have many forms it would be 'nice to have' a non-intrusive option to add something similar to cross-cutting concerns in Aspect oriented programming (AOP).

For example, if I had some code for usage statistics tracking which injects additional event handlers, I could simply add this functionality for every form, developers would not have to change the application code, only add code similar to this

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

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

Answer 1

At runtime, you may override the TCustomForm.DoCreate and TCustomFrame.Create methods, as such:

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;

Therefore, your own DoCreate event will be called each time a TForm instance is created.

This code is extracted from mORMoti18n.pas and you can find the patch routines (for Windows and Linux/BSD) in 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.