Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to create an instance of every form in my project?

I have ported an application from ADO to FireDAC applying several RegExp replaces on the source code to convert the ADOQuery, ADOTables, ADOCommands, ADOStoredProcs, etc. ... to the corresponding FireDAC components.

It has worked fine, but now when running that application plenty of forms raise errors because of the type of the persistent fields being different than the type expected (the one defined from ADO when the persistent field was created).

I'm trying to make a list of those errors, creating an instance of all my forms and opening their datasets with persistent fields, and logging the errors. I can get the list of forms from the project source code, but when I try to use FindClass to create each form I get an error telling that the class has not been found.

Is there any other way to create a Form/DataModule from its class name ?.

This is my current code:

class procedure TfrmCheckFormularis.CheckDatasets(ProjecteFile: string);
var frmCheckFormularis: TfrmCheckFormularis;
    Projecte: string;
    rm: TMatch;
    cc: TComponentClass; 
    c: TComponent;
    i: integer;
    Dataset: TFDQuery;
begin
  Projecte := TFile.ReadAllText(ProjecteFile);
  frmCheckFormularis := TfrmCheckFormularis.Create(Application);
  try
    with frmCheckFormularis do begin
      Show;
      qryForms.CreateDataSet;
      qryErrors.CreateDataSet;
      // I get a list of all the forms and datamodules on my project
      for rm in TRegEx.Matches(Projecte, '^(?:.* in '')(?<File>.*)(?:'' {)(?<Class>.*)(?:},)', [roMultiline]) do begin
        qryForms.AppendRecord([rm.Groups['File'].Value, rm.Groups['Class'].Value]);
      end;

      // Check every form and datamodule
      qryForms.First;
      while not qryForms.Eof do begin
        cc := TComponentClass(FindClass(qryFormsClass.Value));
        c := cc.Create(frmCheckFormularis);
        try
          for i := 0 to c.ComponentCount - 1 do begin
            if c.Components[i] is TFDQuery then begin
              Dataset := c.Components[i] as TFDQuery;
              // When the Dataset has persistent fields, I open it to check if the persistent fields are correct
              if Dataset.FieldDefs.Count > 1 then begin
                try
                  Dataset.Open;
                except
                  on E: Exception do qryErrors.AppendRecord([c.Name, Dataset.Name, E.Message]);
                end;
              end;
            end;
          end;
        finally
          c.Free;
        end;
        qryForms.Next;
      end;
    end;
  finally
    frmCheckFormularis.Free;
  end;
end;

Thank you.

like image 586
Marc Guillot Avatar asked Dec 31 '22 21:12

Marc Guillot


1 Answers

Using the "new" RTTI in Delphi is quite easy. The following code will (hopefully*) create one instance of each form in your application:

procedure TForm1.Button1Click(Sender: TObject);
var
  Context: TRttiContext;
  &Type: TRttiType;
  InstanceType: TRttiInstanceType;
begin
  Context := TRttiContext.Create;
  for &Type in Context.GetTypes do
  begin
    if (&Type.TypeKind = tkClass) and &Type.IsInstance then
    begin
      InstanceType := TRttiInstanceType(&Type);
      if InstanceType.MetaclassType.InheritsFrom(TForm) and (InstanceType.MetaclassType <> TForm) then
        TFormClass(InstanceType.MetaclassType).Create(Application){.Show}; // optionally show it
    end;
  end;
end;

* Technically, it will create one instance of each proper descendant class of TForm.

like image 124
Andreas Rejbrand Avatar answered Jan 14 '23 08:01

Andreas Rejbrand