Can we load a dfm file for a form at runtime?

前端 未结 2 480
被撕碎了的回忆
被撕碎了的回忆 2021-01-06 09:25

Is it possible for a Delphi application to receive a dfm file with objects, its properties and event assignments, and load up all those information just like when how they d

相关标签:
2条回答
  • 2021-01-06 09:59

    You are presented a DFM form design file, and you want to instantiate it?

    Without the accompanying PAS source file, this is not possible. You need the implementation of how the class acts and interacts. (If there is no implementation, i.e. the DFM does not refer to event handlers, then you could create a class at runtime if you have or parse the classname from the DFM. But you would have to know or parse all published members of the form class, thus making this solution kind of academical).

    Even if you have the source file, you would need it at compile time in order to be able to create the class.

    If you have both design and source files at compile time, then add them to the project and you would not need to load the form from file since it is included in the executable's resources. Just use the default constructor Create at runtime to create the form.

    When you have a secondary DFM form file for a single PAS source file, then use this kind of trick to create with the CreateNew constructor an alternative form object (e.g. with some controls hidden or styled) based on the same code.

    If your DFM file is at runtime created from a specific state of the form, then create the form as normal but restore that particular state with one of the answers to this question.

    0 讨论(0)
  • 2021-01-06 10:21

    It is indeed possible to load a .dfm file at runtime and create the form represented by that dfm file.

    I have written some code to do exactly that:

    However: please note: You will need to add more RegisterClass(TSomeComponent) lines in the RegisterNecessaryClasses procedure. As written, if you, for example, try to load a .dfm file that includes a TSpeedbutton, you will get an exception: just add the RegisterClass(TSpeedbutton) to the RegisterNecessaryClasses procedure.

    unit DynaFormF;  // This is a normal Delphi form - just an empty one (No components dropped on the form)
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs;
    
    type
      TfrmDynaForm = class(TForm)
      private
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      frmDynaForm: TfrmDynaForm;
    
    implementation
    
    {$R *.dfm}
    
    end.
    

    // :

    unit DynaLoadDfmU;
    {$O-}
    interface
    
    uses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, ExtCtrls, ComCtrls, utils08, DynaFormF;
    
    var
      DebugSL : TStrings;
    
    procedure ShowDynaFormModal(Filename:String);
    
    implementation
    
    procedure RegisterNecessaryClasses;
    begin
      RegisterClass(TfrmDynaForm);
      RegisterClass(TPanel);
      RegisterClass(TMemo);
      RegisterClass(TTimer);
      RegisterClass(TListBox);
      RegisterClass(TSplitter);
      RegisterClass(TEdit);
      RegisterClass(TCheckBox);
      RegisterClass(TButton);
      RegisterClass(TLabel);
      RegisterClass(TRadioGroup);
    end;
    
    type
      TCrackedTComponent = class(TComponent)
      protected
        procedure UpdateState_Designing;
      end;
    
    var
      ClassRegistered : Boolean;
    
    procedure RemoveEventHandlers(SL:TStrings);
    const
      Key1 = ' On';
      Key2 = ' = ';
    
    var
      i, k1,k2 : Integer;
      S        : String;
    
    begin
      for i := SL.Count-1 downto 0 do begin
        S := SL[i];
    
        k1 := pos(Key1, S);
        k2 := pos(Key2, S);
    
        if (k1 <> 0) AND (k2 > k1) then begin
          // remove it:
          SL.Delete(i);
        end;
    
      end;
    end;
    
    procedure ReportBoolean(S:String; B:Boolean);
    const
      Txts : Array[Boolean] of String = (
      'Cleared', 'Set'
      );
    
    begin
      if Assigned(DebugSL) then begin
        S := S + ' : ' + Txts[B];
        DebugSL.Add(S);
      end;
    end;
    
    procedure SetComponentStyles(AForm:TForm);
    var
      AComponent : TComponent;
      i          : Integer;
      B1, B2     : Boolean;
    
    begin
      for i := 0 to AForm.ComponentCount-1 do begin
        AComponent := AForm.Components[i];
        if AComponent is TTimer then begin
          // TTIMER:
          B1 := csDesigning in AComponent.ComponentState;
    
          // Does not work: an attempt to make the TTimer visible like it is in Delphi IDE's form designer.
          TCrackedTComponent(AComponent).UpdateState_Designing;
    
          B2 := csDesigning in AComponent.ComponentState;
          ReportBoolean('Before setting it: ', B1);
          ReportBoolean('After  setting it: ', B2);
        end;
      end;
    end;
    
    procedure ShowDynaFormModalPrim(Filename:String);
    var
      FormDyna : TfrmDynaForm;
    
      S1       : TFileStream;
      S1m      : TMemoryStream;
      S2       : TMemoryStream;
      S        : String;
      k1, k2   : Integer;
      Reader   : TReader;
      SLHelper : TStringlist;
      OK       : Boolean;
    
      MissingClassName, FormName, FormTypeName : String;
    
    begin
      FormName     := 'frmDynaForm';
      FormTypeName := 'TfrmDynaForm';
    
      FormDyna := NIL;
      OK       := False;
    
      S1 := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
      try
        S1m := TMemoryStream.Create;
        try
          SLHelper := TStringlist.Create;
          try
            SLHelper.LoadFromStream(S1);
    
            S := SLHelper[0];
    
            k1 := pos(' ', S);
            k2 := pos(': ', S);
            if (k1 <> 0) AND (k2 > k1) then begin
              // match:
              SetLength(S, k2+1);
              S := 'object ' + FormName + ': ' + FormTypeName;
              SLHelper[0] := S;
            end;
    
            RemoveEventHandlers(SLHelper);
            SLHelper.SaveToStream(S1m);
          finally
            SLHelper.Free;
          end;
    
          S1m.Position := 0;
          S2 := TMemoryStream.Create;
          try
            ObjectTextToBinary(S1m, S2);
            S2.Position := 0;
    
            Reader := TReader.Create(S2, 4096);
            try
              try
                FormDyna := TfrmDynaForm.Create(NIL);
                Reader.ReadRootComponent(FormDyna);
                OK       := True;
                SetComponentStyles(FormDyna);
              except
                on E:Exception do begin
                  S := E.ClassName + '    ' + E.Message;
                  if Assigned(DebugSL) then begin
                    DebugSL.add(S);
                    if (E.ClassName = 'EClassNotFound') then begin
                      // the class is missing - we need one more "RegisterClass" line in the RegisterNecessaryClasses procedure.
                      MissingClassName := CopyBetween(E.Message, 'Class ', ' not found');
                      S := '    RegisterClass(' + MissingClassName + ');';
                      DebugSL.Add(S);
                    end;
                  end;
                end;
              end;
            finally
              Reader.Free;
            end;
          finally
            S2.Free;
          end;
        finally
          S1m.Free;
        end;
      finally
        S1.Free;
      end;
    
      if OK then begin
        try
          FormDyna.Caption := 'Dynamically created form: ' + ' -- ' + FormDyna.Caption;
          FormDyna.ShowModal;
    
        finally
          FormDyna.Free;
        end;
      end else begin
        // failure:
        S := 'Dynamic loading of form file failed.';
        if Assigned(DebugSL)
          then DebugSL.Add(S)
      end;
    end;
    
    procedure ShowDynaFormModal(Filename:String);
    begin
      if NOT ClassRegistered then begin
        ClassRegistered := True;
        RegisterNecessaryClasses;
      end;
    
      ShowDynaFormModalPrim(Filename);
    end;
    
    { TCrackedTComponent }
    
    procedure TCrackedTComponent.UpdateState_Designing;
    begin
      SetDesigning(TRUE, FALSE);
    end;
    
    end.
    
    0 讨论(0)
提交回复
热议问题