3

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

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;

The question is: Can I create a generic function to create the forms like :

Procedure SetForm(nForm: ShortInt);
Begin
xForm : TForm;
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 show, something like:

xForm.SetUser(nUser);

I tried this just to create and activate the form

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

procedure CreateForm(nForm: ShortInt);

var
  arrayForm: array[1..2] of TFormInfo = (
    (ClassType: TFormParam; Form : nil),
    (ClassType: TFormCliGrid; Form: nil)
  );

implementation

procedure CreateForm(nForm:ShortInt);
var xForm:TForm;
begin
    xForm := arrayForm[nForm].Form;
    if not Assigned(xForm) then
        begin
        xForm := arrayForm[nForm].ClassType.Create(Application);
        arrayForm[nForm].Form := xForm;
        end;
    xForm.Show;
end;

When I tried to change the combobox in the second Form (FormCliGrid) on FormActivate

...
comboStatus.Items.BeginUpdate;

I got the 'Access Violation'

1 Answer 1

4

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;
Sign up to request clarification or add additional context in comments.

2 Comments

Thanks Remy for your answer but it didn't work. I might be doing something wrong. I tried the second solution but I got an 'Access Violation' trying to access some object inside the form.
@ZetaSistemas then please update your question to show the code you tried that is not working for you.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.