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

前端 未结 2 489
被撕碎了的回忆
被撕碎了的回忆 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 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.
    

提交回复
热议问题