How to dynamically create forms on Delphi

Zeta Sistemas 0
Viewed 102

I have a Delphi 10.4 application with 20+ forms that are created dynamically. There is a function that creates each form, like this:

Procedure SetForm(nForm : ShortInt);
Begin
  Case nForm of
    1: begin
      If not Assigned(Form1) then
        Application.CreateForm(TForm1, Form1);
      Form1.Show;
    End;
    2: begin
      If not Assigned(Form2) then
        Application.CreateForm(TForm2, Form2);
      Form2.Show;
    End;
    …
  End;
End;

Can I create a generic function to create the forms, like this?

Procedure SetForm(nForm: ShortInt);
Var
  xForm : TForm;
Begin
  xForm := arrayForm[nForm];    // Array containing all forms;
  if not Assigned(xForm) then
    Application.CreateForm((some cast as TComponentClass), xForm);
  xForm.Show;
end;

To complicate matters some, forms have a function that needs to execute before being shown, something like this:

xForm.SetUser(nUser);
delphi
1 Answers

Yes, what you are asking for is quite doable, using metaclasses with TForm's virtual constructor.

For example, you can create a base class to access the common functionality for all Forms, eg:

type
  TMyBaseForm = class(TForm)
  public
    procedure SetUser(nUser: UserTypeHere); virtual; abstract;
  end;

  TMyBaseFormClass = class of TMyBaseForm;

type
  TForm1 = class(TMyBaseForm)
  public
    procedure SetUser(nUser: UserTypeHere); override;
  end;

  TForm2 = class(TMyBaseForm)
  public
    procedure SetUser(nUser: UserTypeHere); override;
  end;

  ...

type
  TFormInfo = record
    ClassType: TMyBaseFormClass;
    Form: TMyBaseForm;
  end;

var
  arrayForm: array[0..1] of TFormInfo = (
    (ClassType: TForm1; Form: nil),
    (ClassType: TForm2; Form: nil)
  );

Procedure SetForm(nForm: ShortInt);
Var
  xForm : TMyBaseForm;
Begin
  xForm := arrayForm[nForm].Form;
  if not Assigned(xForm) then
  begin
    xForm := arrayForm[nForm].ClassType.Create(Application);
    arrayForm[nForm].Form := xForm;
  end;
  xForm.SetUser(nUser);
  xForm.Show;
end;

Alternatively, if using a base class is not an option, you can use an interface instead, eg:

type
  ISetUser = interface
    ['{6cc8854b-f945-4a0d-ab13-624a13eaade1}']
    procedure SetUser(nUser: UserTypeHere);
  end;

type
  TForm1 = class(TForm, ISetUser)
  public
    procedure SetUser(nUser: UserTypeHere);
  end;

  TForm2 = class(TForm, ISetUser)
  public
    procedure SetUser(nUser: UserTypeHere);
  end;

  ...

type
  TFormInfo = record
    ClassType: TFormClass;
    Form: TForm;
  end;

var
  arrayForm: array[0..1] of TFormInfo = (
    (ClassType: TForm1; Form: nil),
    (ClassType: TForm2; Form: nil)
  );

Procedure SetForm(nForm: ShortInt);
Var
  xForm : TForm;
  Intf: ISetUser;
Begin
  xForm := arrayForm[nForm].Form;
  if not Assigned(xForm) then
  begin
    xForm := arrayForm[nForm].ClassType.Create(Application);
    arrayForm[nForm].Form := xForm;
  end;
  if Supports(xForm, ISetUser, Intf) then
    Intf.SetUser(nUser);
  xForm.Show;
end;
Remy Lebeau0
Related