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.

Sign In

if possible load dfm files at runtime using ObjectTextToBinary ?

Recommended Posts

KingOrmon

Sherzod

Luis German

Luis German

izotope

Luciano França

Luis German

Luis German

Luciano França

asapltda

Luciano França

Dm_Ufa

风吹小机机

Luciano França

Join the conversation

Browse

Activity