Reputation: 51
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'
Upvotes: 3
Views: 553
Reputation: 598194
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;
Upvotes: 4