if possible load dfm files at runtime using ObjectTextToBinary ?

KingOrmon · March 26, 2014

Hello,

I would like to load DFM files at runtime, for allows me modify uniforms without recompile.

I am trying to load without succes via this function:

procedure LoadComponentFromFile(Component: TComponent; const FileName: TFileName);
var
  FileStream : TFileStream;
  MemStream : TMemoryStream;
  i: Integer;
begin
  MemStream := nil;

  if not Assigned(Component) then
    raise Exception.Create('Component is not assigned');

  if FileExists(FileName) then
  begin
    FileStream := TFileStream.Create(FileName,fmOpenRead);
    try
      for i := Component.ComponentCount - 1 downto 0 do
      begin
        if Component.Components[i] is TControl then
          TControl(Component.Components[i]).Parent := nil;
        Component.Components[i].Free;
      end;

      MemStream := TMemoryStream.Create;
      ObjectTextToBinary(FileStream, MemStream);
      MemStream.Position := 0;
      MemStream.ReadComponent(Component);
      Application.InsertComponent(Component);
    finally
      MemStream.Free;
      FileStream.Free;
    end;
  end;
end;

Sherzod · March 27, 2014

Hi KingOrmon.

can will help (you may have already have looked these links...)

http://stackoverflow.com/questions/19989389/can-we-load-a-dfm-file-for-a-form-at-runtime

http://stackoverflow.com/questions/3163586/best-way-to-save-restore-a-form-foss

Luis German · March 20, 2023

Hi:
Following the links and writing a similar scenery on unigui, I got an Access violation message error when readcomponent function is called.

I Attached the code, a text with saved form, and a picture where the function is called.

Thanks for your help.-

Luis.

Basico.zip forma1.txt

Luis German · March 20, 2023

Please let me know if there is any suggest about it.

izotope · June 29, 2023

On 3/20/2023 at 3:21 AM, Luis German said:
Hi:
Following the links and writing a similar scenery on unigui, I got an Access violation message error when readcomponent function is called.
I Attached the code, a text with saved form, and a picture where the function is called.

Thanks for your help.-

Luis.

Basico.zipUnavailable forma1.txtUnavailable

Your samples is unavailable.

Please retry upload files again.

Luciano França · June 29, 2023

I did it in a different way

I created a form changer
I'm still going to adapt it to Unigui but I believe it's simple

see the code below


Procedure P_ObjListaLayoutCtrl(FormSelf: TForm_HostBase; SalvarLer: String; ListObjetos: TStrings; DiminuirScala: Boolean = True; Modified: Boolean = False);
Var I: Integer;
Var aHeightScala, aWidthScala: Double;
Var Linha, aNameComp, aNameForm, aPropComp, aValorComp: String;
Var aComp: TControl;
Var ctx: TRttiContext;
Var Prop: TRttiProperty;
Var varPropInfo: PPropInfo;

 Function F_AnchorsToString(Tipo: TAnchorKind): String;
 Begin
  Result := 'False';

  if akLeft = Tipo Then Begin
   if akLeft in aComp.Anchors Then
    Result := 'True'
   Else
    Result := 'False';
  End;

  if akTop = Tipo Then Begin
   if akTop in aComp.Anchors Then
    Result := 'True'
   Else
    Result := 'False';
  End;

  if akRight = Tipo Then Begin
   if akRight in aComp.Anchors Then
    Result := 'True'
   Else
    Result := 'False';
  End;

  if akBottom = Tipo Then Begin
   if akBottom in aComp.Anchors Then
    Result := 'True'
   Else
    Result := 'False';
  End;

 End;

begin
 // Button1:Width=150
 Try

  if SalvarLer = 'L' then Begin

   if Trim(ListObjetos.Text) = EmptyStr then
    Exit;

   For I := 0 To ListObjetos.Count - 1 do Begin
    Linha := ListObjetos.Strings[I];

    if (Pos('[', Linha) > 0) And (Pos(']', Linha) > 0) then Begin
     aNameForm := Copy(Linha, 2, Pos(']', Linha) - 2);
     Break;
    End;

   End;

   if aNameForm <> FormSelf.ClassName Then Begin
    ShowDialog(FormSelf, 'Esse Arquivo de DFM "' + aNameForm + '" Não corresponde a esse Form "' + FormSelf.ClassName + '"');
    Exit;
   End;

   For I := 0 To ListObjetos.Count - 1 do Begin
    Linha := ListObjetos.Strings[I];

    aNameComp := Copy(Linha, 1, Pos(':', Linha) - 1);
    aPropComp := Copy(Linha, Pos(':', Linha) + 1, (Pos('=', Linha)) - Pos(':', Linha) - 1);
    aValorComp := Copy(Linha, Pos('=', Linha) + 1, 999);

    if Trim(aNameComp) <> EmptyStr then Begin

     aComp := TControl(FormSelf.FindComponent(aNameComp));

     if Not Assigned(aComp) Then
      continue;

     if Modified Then Begin
      aComp.Tag := -3377;
      continue;
     End;

     if aPropComp = 'Align' Then
      aComp.Align := TAlign(StrtointDef(aValorComp, 0));

     if aPropComp = 'Parent' Then Begin
      if (aValorComp = FormSelf.Name) Or (aValorComp = F_ClassNameForm(FormSelf)) then
       aComp.Parent := FormSelf
      Else
       aComp.Parent := {$IFDEF VCL} TWinControl {$ELSE} TUniControl {$ENDIF}(FormSelf.FindComponent(aValorComp));

      if Not Assigned(aComp.Parent) Then
       aComp.Parent := F_GetPanelParentNil(FormSelf);
     End;

     if aPropComp = 'Left' Then
      aComp.Left := StrToInt(aValorComp);

     if aPropComp = 'Top' Then
      aComp.Top := StrToInt(aValorComp);

     if aPropComp = 'Height' Then
      aComp.Height := StrToInt(aValorComp);

     if aPropComp = 'Width' Then
      aComp.Width := StrToInt(aValorComp);

     if aComp is {$IFDEF VCL} TWinControl {$ELSE} TUniControl {$ENDIF} Then Begin
      if aPropComp = 'TabOrder' Then
       {$IFDEF VCL} TWinControl {$ELSE} TUniControl {$ENDIF}(aComp).TabOrder := StrtointDef(aValorComp, 0);

      if (aPropComp = 'TabStop') And (Trim(aValorComp) <> EmptyStr) Then Begin
       if aValorComp = 'True' Then
        {$IFDEF VCL} TWinControl {$ELSE} TUniControl {$ENDIF}(aComp).TabStop := True
       Else
        {$IFDEF VCL} TWinControl {$ELSE} TUniControl {$ENDIF}(aComp).TabStop := False;
      End;
     End;

     if (aPropComp = 'akLeft') And (Trim(aValorComp) <> EmptyStr) Then Begin
      if aValorComp = 'True' Then
       aComp.Anchors := aComp.Anchors + [akLeft]
      Else
       aComp.Anchors := aComp.Anchors - [akLeft];
     End;

     if (aPropComp = 'akTop') And (Trim(aValorComp) <> EmptyStr) Then Begin
      if aValorComp = 'True' Then
       aComp.Anchors := aComp.Anchors + [akTop]
      Else
       aComp.Anchors := aComp.Anchors - [akTop];
     End;

     if (aPropComp = 'akRight') And (Trim(aValorComp) <> EmptyStr) Then Begin
      if aValorComp = 'True' Then
       aComp.Anchors := aComp.Anchors + [akRight]
      Else
       aComp.Anchors := aComp.Anchors - [akRight];
     End;

     if (aPropComp = 'akBottom') And (Trim(aValorComp) <> EmptyStr) Then Begin
      if aValorComp = 'True' Then
       aComp.Anchors := aComp.Anchors + [akBottom]
      Else
       aComp.Anchors := aComp.Anchors - [akBottom];
     End;

     if (aPropComp = 'Caption') And (Trim(aValorComp) <> EmptyStr) Then Begin
      if aComp is TButton then
       TButton(aComp).Caption := aValorComp;

      if aComp is TLabel then
       TLabel(aComp).Caption := aValorComp;
     End;

     if aPropComp = 'PageIndex' Then Begin
      if (aComp is TTabSheet) And (StrtointDef(aValorComp, -1) > -1) then
       if (TPageControl(TTabSheet(aComp).Parent).PageCount - 1) >= (StrtointDef(aValorComp, 0)) Then
        TTabSheet(aComp).PageIndex := StrtointDef(aValorComp, 0);
     End;

    End;

   End;
  End;

  if SalvarLer = 'S' then Begin

   if FormSelf is TForm_HostDae then Begin
    {$IFDEF VCL}
    aHeightScala := TForm_HostDae(FormSelf).LfResizerVcl.HeightScala;
    aWidthScala := TForm_HostDae(FormSelf).LfResizerVcl.WidthScala;
    {$ELSE}
    {$ENDIF}
   End
   Else Begin
    aHeightScala := 1;
    aWidthScala := 1;
   End;

   ListObjetos.Clear;
   ListObjetos.Add('[' + FormSelf.ClassName + ']');

   For I := 0 To FormSelf.ComponentCount - 1 do Begin
    if (FormSelf.Components[I] is TControl) And (TControl(FormSelf.Components[I]).Tag = -3377) then Begin
     aComp := {$IFDEF VCL} TWinControl {$ELSE} TUniControl {$ENDIF}(FormSelf.Components[I]);

     if Not Assigned(aComp) Then
      continue;

     if Assigned(aComp.Parent) Then
      ListObjetos.Add(aComp.Name + ':Parent=' + aComp.Parent.Name)
     Else
      ListObjetos.Add(aComp.Name + ':Parent=Nil');

     if Assigned(aComp.Parent) Then Begin
      Prop := ctx.GetType(aComp.ClassType).GetProperty('Caption');
      if (Assigned(Prop)) and (Prop.Visibility in [mvPublic, mvPublished]) then
       ListObjetos.Add(aComp.Name + ':Caption=' + Prop.GetValue(aComp).Asstring);
     End;

     ListObjetos.Add(aComp.Name + ':Align=' + IntToStr(Integer(aComp.Align)));

     ListObjetos.Add(aComp.Name + ':Left=' + Floattostr(F_GetTamOriginal(aComp.Left, aWidthScala, DiminuirScala)));
     ListObjetos.Add(aComp.Name + ':Top=' + Floattostr(F_GetTamOriginal(aComp.Top, aHeightScala, DiminuirScala)));
     ListObjetos.Add(aComp.Name + ':Height=' + Floattostr(F_GetTamOriginal(aComp.Height, aHeightScala, DiminuirScala)));
     ListObjetos.Add(aComp.Name + ':Width=' + Floattostr(F_GetTamOriginal(aComp.Width, aWidthScala, DiminuirScala)));

     ListObjetos.Add(aComp.Name + ':akLeft=' + F_AnchorsToString(akLeft));
     ListObjetos.Add(aComp.Name + ':akTop=' + F_AnchorsToString(akTop));
     ListObjetos.Add(aComp.Name + ':akRight=' + F_AnchorsToString(akRight));
     ListObjetos.Add(aComp.Name + ':akBottom=' + F_AnchorsToString(akBottom));

     if aComp is {$IFDEF VCL} TWinControl {$ELSE} TUniControl {$ENDIF} Then Begin
      ListObjetos.Add(aComp.Name + ':TabOrder=' + IntToStr({$IFDEF VCL} TWinControl {$ELSE} TUniControl {$ENDIF}(aComp).TabOrder));

      if {$IFDEF VCL} TWinControl {$ELSE} TUniControl {$ENDIF}(aComp).TabStop Then
       ListObjetos.Add(aComp.Name + ':TabStop=True')
      Else
       ListObjetos.Add(aComp.Name + ':TabStop=False');
     End;

     if aComp is TTabSheet Then
      ListObjetos.Add(aComp.Name + ':PageIndex=' + IntToStr(TTabSheet(aComp).PageIndex));

    End;
   End;
  End;

 except
  on E: Exception do begin
   P_LogException(E); // Mudo
  end;
 end;

End;

Unit_LayoutControl.pas Unit_LayoutControl.dfm

Luis German · June 29, 2023

Hi Luciano:

May you send an example project using these files?

Thanks

Luis.

Luis German · June 29, 2023

forma1.txt Basico.zip

I attach the files again.

Regards

Luis.

Luciano França · June 29, 2023

3 hours ago, Luis German said:

Hi Luciano:

May you send an example project using these files?

Thanks

Luis.

This code works in VCL and currently I'm porting this code to Unigui

Once it's working I'll post a full demo for you

asapltda · July 5, 2023

+1

Luciano França · July 31, 2023

On 7/5/2023 at 5:05 PM, asapltda said:

+1

Guys sorry for the delay
Very correct the migration from 500,000 to unigui is not easy

no time to create a Demo.
I'll explain better

procedure TForm_CadastroTipoProduto.FormCreate(Sender: TObject);
begin
 F_LayoutControl(Self, 'L');

end;

procedure TForm_CadastroTipoProduto.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 F_LayoutControl(Self, 'S');
 
end;

another reason for the delay is that it is still not working 100%
in this way attached version 100% unigui

Note these forms are the VCL standard
as my system is Hybrid I transform from VCL to Unigui in the compilation, so colleagues will have to make the necessary changes.

Unit_LayoutControl.pas Unit_LayoutControl.dfm VCL_UniGUI.Inc Funcoes.pas

Dm_Ufa · July 31, 2023

Hello! i use two functions:

function LoadDFM(p :TComponent; dfm :TStringList) :string;
var
MemoryStream, FileStream :TMemoryStream;
begin
MemoryStream := TMemoryStream.Create();
FileStream := TMemoryStream.Create();

dfm.SaveToStream(FileStream);
FileStream.Position := 0;

ObjectTextToResource(FileStream, MemoryStream);

MemoryStream.Position := 0;
MemoryStream.ReadComponentRes(p);

MemoryStream.Destroy();
FileStream.Destroy();

Result := p.Name;
end;

function SaveDFM(p :TComponent) :TStringList;
var
MemoryStream, FileStream :TMemoryStream;
begin
MemoryStream := TMemoryStream.Create;
FileStream := TMemoryStream.Create;

MemoryStream.WriteComponentRes('aaa', p);
MemoryStream.Position := 0;

ObjectResourceToText(MemoryStream, FileStream);

FileStream.Position := 0;

Result := TStringList.Create;
Result.LoadFromStream(FileStream);

MemoryStream.Destroy;
FileStream.Destroy;
end;

风吹小机机 · August 1, 2023

http://forums.unigui.com/uploads/monthly_2023_07/1555289297_HelloWorld.gif.38717fafc7e022c9a39565a93a70b08a.gif

Luciano França · August 3, 2023

On 8/1/2023 at 12:50 AM, 风吹小机机 said:

http://forums.unigui.com/uploads/monthly_2023_07/1555289297_HelloWorld.gif.38717fafc7e022c9a39565a93a70b08a.gif 2.73 MB · 0 downloads

Please make videos in English, it's much better to understand than Chinese.

Grateful.

if possible load dfm files at runtime using ObjectTextToBinary ?

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Join the conversation