load a dfm file for a form at runtime

 
 load a dfm file for a form at runtime 

https://coderedirect.com/questions/382641/can-we-load-a-dfm-file-for-a-form-at-runtime
 

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. 

Windows

You can associate an event with a socket with WSAEventSelect and wait with WaitForMultipleObjectsEx for the data on the socket or mutex or semaphore event etc.
Linux

You can use the futex syscall with FUTEX_FD argument (however this has been removed from the kernel), or use eventfd to implement the condition variable.

And you can spawn a second thread that would be waiting on the condition variable, and signal the one waiting in select(). Or ask for signals when input is received on the socket, etc. See this related question.

The reason is because Delphi uses Automatic Reference Counting for Objects on mobile platforms (iOS and Android), but not on desktop platforms (Windows and OSX). Your Free() is effectively a no-op, because accessing the component from the Components[] property will increment its reference count, and then the Free() will decrement it (in fact, the compiler should have issued a warning about the code having no effect). The component still has active references to it (its Owner and Parent), so it is not actually freed.

If you want to force the component to be freed, you need to call DisposeOf() on it, eg:

for LIndex := form4.ComponentCount-1 downto 0 do
begin
  if form4.Components[LIndex] is TVertScrollBox then
  begin
    form4.Components[LIndex].DisposeOf;
  end;
end;

Alternatively, remove the active references and let ARC handle the destruction normally:

var
  VertScrollLink: TVertScrollBox;
  LIndex: Integer;
begin
  ...
  for LIndex := form4.ComponentCount-1 downto 0 do
  begin
    if form4.Components[LIndex] is TVertScrollBox then
    begin
      VertScrollLink := TVertScrollBox(form4.Components[LIndex]);
      VertScrollLink.Parent := nil;
      VertScrollLink.Owner.RemoveComponent(VertScrollLink);
      VertScrollLink := nil;
    end;
  end;
  ...
end;

That being said, you might consider keeping track of the component you create so you don't need to use a loop to find it later:

type
  TForm4 = class(TForm)
    procedure FormShow(Sender: TObject);
    ...
  private
    VertScrollLink: TVertScrollBox;
    ...
  end;

procedure TForm4.FormShow(Sender: TObject);
begin
  VertScrollLink := TVertScrollBox.Create(Self);
  VertScrollLink.Align := TAlignLayout.Client;
  VertScrollLink.Parent := Self;
end;

begin
  ...
  if Assigned(VertScrollLink) then
  begin
    VertScrollLink.DisposeOf;
    { or:
    VertScrollLink.Parent := nil;
    VertScrollLink.Owner.RemoveComponent(VertScrollLink);
    }
    VertScrollLink := nil;
  end;
  ...
end;