盒子论坛 v2.1

try my code: RAD Studio 10.3.3 but I believe that works in other editions

----------
unit uMainForm;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls,
  Data.DB,
  Vcl.Grids,
  Vcl.DBGrids;

type
  TfrmMainForm = class(TForm)
    btn_Create_DFM_file : TButton;
    btn_Loading_DFM_file_as_a_Form: TButton;
    DBGrid1: TDBGrid;
    BtnAddNewColumnsOnDBGrid: TButton;
    procedure btn_Create_DFM_fileClick(Sender: TObject);
    procedure btn_Loading_DFM_file_as_a_FormClick(Sender: TObject);
    procedure BtnAddNewColumnsOnDBGridClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMainForm: TfrmMainForm;

implementation

{$R *.dfm}

procedure TfrmMainForm.BtnAddNewColumnsOnDBGridClick(Sender: TObject);
var
  MyNewColumn     : TColumn;
  MyNewColumnTitle: TColumnTitle;
  i          : integer;
begin
  for i := 0 to 1 do { 2columns }
  begin
    MyNewColumn       := DBGrid1.Columns.Add;
    MyNewColumn.Field := nil; // MyNewColumn.FieldName :=  '';
    // ... etc...
    //
    try
      MyNewColumnTitle         := TColumnTitle.Create(MyNewColumn);
      MyNewColumnTitle.Caption := Format('MyNewColumn%d', [i]); { UNIQUE NAME.... OK? }
      //
      MyNewColumn.Title := MyNewColumnTitle;
    finally
      MyNewColumnTitle.Free; // <----
    end;
  end;
end;

procedure TfrmMainForm.btn_Create_DFM_fileClick(Sender: TObject);
var
  myNewDFM       : TStream;
  myStreamToWorks: TStream;
begin
  try
    myNewDFM        := TFileStream.Create('myNewDFMfile.dfm', fmCreate);
    myStreamToWorks := TMemoryStream.Create;
    try
      //
      myStreamToWorks.WriteComponent(frmMainForm);
      myStreamToWorks.Seek(0, soFromBeginning);
      //
      ObjectBinaryToText(myStreamToWorks, myNewDFM);
    except
      on E: Exception do
        ShowMessage('My Error: ' + E.message);
    end;
  finally
    myNewDFM.Free;
    myStreamToWorks.Free;
  end;
end;

procedure TfrmMainForm.btn_Loading_DFM_file_as_a_FormClick(Sender: TObject);
var
  myNewDFM       : TStream;
  myStreamToWorks: TStream;
begin
  try
    myNewDFM        := TFileStream.Create('myNewDFMfile.dfm', fmOpenRead);
    myStreamToWorks := TMemoryStream.Create;
    try
      myNewDFM.Seek(0, soFromBeginning);
      //
      ObjectTextToBinary(myNewDFM, myStreamToWorks);
      //
      myStreamToWorks.Seek(0, soFromBeginning);
      //
      frmMainForm.DestroyComponents; // destroying current comoponents...
      //
      // try comment this line to see that the components dont will be "loaded"...
      myStreamToWorks.ReadComponent(frmMainForm); // receiving the components definitions...
      //
    except
      on E: Exception do
        ShowMessage('My Error: ' + E.message);
    end;
  finally
    myNewDFM.Free;
    myStreamToWorks.Free;
  end;
end;

initialization

ReportMemoryLeaksOnShutdown := true;

finalization

end.
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!RAD 11.3

作者：

emailx45 (emailx45)	▲▲▲▲△	-
	普通会员

2021/7/19 2:47:08

2楼：

Resulted on DFM file :

----------
object frmMainForm: TfrmMainForm
  Left = 156
  Top = 156
  ActiveControl = btn_Create_DFM_file
  Caption = 'frmMainForm'
  ClientHeight = 299
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesigned
  Visible = True
  PixelsPerInch = 96
  TextHeight = 13
  object btn_Create_DFM_file : TButton
    Left = 400
    Top = 24
    Width = 209
    Height = 25
    Caption = 'btn_Create_DFM_file'
    TabOrder = 0
    OnClick = btn_Create_DFM_fileClick
  end
  object btn_Loading_DFM_file_as_a_Form: TButton
    Left = 400
    Top = 128
    Width = 209
    Height = 25
    Caption = 'btn_Loading_DFM_file_as_a_Form'
    TabOrder = 1
    OnClick = btn_Loading_DFM_file_as_a_FormClick
  end
  object DBGrid1: TDBGrid
    Left = 8
    Top = 104
    Width = 369
    Height = 169
    TabOrder = 2
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'Tahoma'
    TitleFont.Style = []
    Columns = <
      item
        Expanded = False
        Title.Caption = 'MyNewColumn0'
        Visible = True
      end
      item
        Expanded = False
        Title.Caption = 'MyNewColumn1'
        Visible = True
      end>
  end
  object BtnAddNewColumnsOnDBGrid: TButton
    Left = 104
    Top = 56
    Width = 193
    Height = 25
    Caption = 'BtnAddNewColumnsOnDBGrid'
    TabOrder = 3
    OnClick = BtnAddNewColumnsOnDBGridClick
  end
end
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!RAD 11.3

作者：

hklh2000 (凯哥)	▲▲▲▲▲	-
	普通会员

2021/7/24 0:36:52

3楼：

Var
Newform:Tform
Newdbgrid:Tdbgrid

Newform:=Tform.create();

Newdbgrid:=Tdbgrid.create(Newform);
Newdbgrid.columns.add;

writecomponent('c:\Newform.dfm',Newform);

动态创建的 form，动态创建的dbgrid ,动态创建 column 用writecomponent(Newform); 无法保存子控件 column//
----------------------------------------------
-

信息

登陆以后才能回复