Delphi自编程序生成.dfm以及关联.pas的方法二

本文链接：https://blog.youkuaiyun.com/qq_34604490/article/details/125629792

本文介绍了一种利用Delphi自动生成DFM及关联PAS文件的方法。通过编写工具并设置模板，可以批量生成指定数量的控件，并自动生成对应的DFM和PAS文件，便于进行设计和二次开发。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

Delphi自编程序生成.dfm以及关联.pas的方法二

前面介绍了方法一，现在介绍方法二

首先，编写一个工具，方便通过模板生成动态dfm文件，工具内容如下：

新建工程文件，form1上放置一个按钮Button1，两个Tmemo类型控件，memo1，memo2，和一个opendialog1控件

控件按钮onclick事件如下：

procedure TForm1.Button1Click(Sender: TObject);

var

I:Integer;

S:String;

begin

if OpenDialog1.Execute then

begin

Memo2.Lines.Clear;

Memo2.Lines.Add('procedure TForm1.toProcDfmPasS;');

Memo2.Lines.Add('var');

Memo2.Lines.Add('TS:TStrings;');

Memo2.Lines.Add('Begin');

Memo2.Lines.Add('TS:=TStringList.Create;');

Memo2.Lines.Add(' try');

Memo2.Lines.Add(' TS.clear;');

Memo1.Lines.LoadFromFile(OpenDialog1.FileName);

for I := 0 to Memo1.Lines.Count-1 do

begin

S:=Memo1.Lines[I];

S:=Quotedstr(S);

S:='TS.ADD('+S+');';

Memo2.Lines.Add(S);

end;

memo2.Lines.Add('TS.SaveToFile('+QuotedStr('D:\unit2.pas')+');');

memo2.Lines.Add('finally');

memo2.Lines.Add('TS.Free;');

memo2.Lines.Add('end;');

end;

这个事件用于打开模板.dfm,生成自动化.dfm或者.pas的原型.过程，

如果.dfm是二进制的，用如下函数转为文本模式

procedure TFmMemoEdit.DfmBin2Txt(ADfmFileName: string);

Var

inFileStream: TMemoryStream;

outFileStream: TFileStream;

begin

inFileStream := TMemoryStream.Create;

inFileStream.LoadFromFile(ADfmFileName);

try

outFileStream := TFileStream.Create(ADfmFileName, fmCreate);

try

inFileStream.Seek(0, soFromBeginning);

ObjectResourceToText(inFileStream, outFileStream);

except

Raise Exception.Create('This dfm is bin, error on trans bin to txt.');

end;

finally

outFileStream.Free;

end;

finally

inFileStream.Free;

end;

新建form2，放置静态控件pagecontrol1，新建一个tabsheet1,加上一个button1。

用form1的button1的onclick事件分别打开form2的.dfm和.pas，生成过程，修改过程名字，以及过程中TS.add(‘字串’)中出现单引号的语句，

使用QuotedStr(S)函数加上引号

模板.dfm如下

object Form2: TForm2

Left = 0

Top = 0

Caption = 'Form2'

ClientHeight = 433

ClientWidth = 622

Color = clBtnFace

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -12

Font.Name = 'Segoe UI'

Font.Style = []

OnCreate = FormCreate

OnDestroy = FormDestroy

TextHeight = 15

object PageControl1: TPageControl

Left = 0

Top = 0

Width = 622

Height = 433

ActivePage = TabSheet1

Align = alClient

TabOrder = 0

object TabSheet1: TTabSheet

Caption = 'TabSheet1'

object Button1: TButton

Left = 72

Top = 48

Width = 75

Height = 25

Caption = 'Button1'

TabOrder = 0

end

生成过程如下：

procedure TForm1.toProcDfmPasS;

var

TS:TStrings;

Begin

TS:=TStringList.Create;

try

TS.clear;

TS.ADD('object Form2: TForm2');

TS.ADD(' Left = 0');

TS.ADD(' Top = 0');

TS.ADD(' Caption = ''Form2''');

TS.ADD(' ClientHeight = 433');

TS.ADD(' ClientWidth = 622');

TS.ADD(' Color = clBtnFace');

TS.ADD(' Font.Charset = DEFAULT_CHARSET');

TS.ADD(' Font.Color = clWindowText');

TS.ADD(' Font.Height = -12');

TS.ADD(' Font.Name = ''Segoe UI''');

TS.ADD(' Font.Style = []');

TS.ADD(' OnCreate = FormCreate');

TS.ADD(' OnDestroy = FormDestroy');

TS.ADD(' TextHeight = 15');

TS.ADD(' object PageControl1: TPageControl');

TS.ADD(' Left = 0');

TS.ADD(' Top = 0');

TS.ADD(' Width = 622');

TS.ADD(' Height = 433');

TS.ADD(' ActivePage = TabSheet1');

TS.ADD(' Align = alClient');

TS.ADD(' TabOrder = 0');

TS.ADD(' object TabSheet1: TTabSheet');

TS.ADD(' Caption = ''TabSheet1''');

TS.ADD(' object Button1: TButton');

TS.ADD(' Left = 72');

TS.ADD(' Top = 48');

TS.ADD(' Width = 75');

TS.ADD(' Height = 25');

TS.ADD(' Caption = ''Button1''');

TS.ADD(' TabOrder = 0');

TS.ADD(' end');

TS.ADD('end');

TS.SaveToFile('D:\unit2.dfm');

finally

TS.Free;

end;

这样可以在上面加上一些语句用于生成控件的文本，比如在TS.ADD(' Caption = ''TabSheet1''');下面加上

For i:=0 to 100 do

Begin

S:=’btn’+inttostr(i);

TS.ADD(' object ‘+S+’: TButton');

TS.ADD(' Left = 72');

TS.ADD(' Top = 48');

TS.ADD(' Width = 75');

TS.ADD(' Height = 25');

TS.ADD(' Caption = ''Button1''');

TS.ADD(' TabOrder = 0');

TS.ADD(' end');

End;

就会在unit2.dfm文件中生成101个新按钮。

打开unit2.pas，生成如下代码

procedure TForm1.toProcDfmPasS;

var

TS:TStrings;

Begin

TS:=TStringList.Create;

try

TS.clear;

TS.ADD('unit Unit2;');

TS.ADD('');

TS.ADD('interface');

TS.ADD('');

TS.ADD('uses');

TS.ADD(' Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,');

TS.ADD(' Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls;');

TS.ADD('');

TS.ADD('type');

TS.ADD(' TForm2 = class(TForm)');

TS.ADD(' PageControl1: TPageControl;');

TS.ADD(' TabSheet1: TTabSheet;');

TS.ADD(' Button1: TButton;');

TS.ADD(' private');

TS.ADD(' { Private declarations }');

TS.ADD(' public');

TS.ADD(' { Public declarations }');

TS.ADD(' end;');

TS.ADD('');

TS.ADD('var');

TS.ADD(' Form2: TForm2;');

TS.ADD('');

TS.ADD('implementation');

TS.ADD('');

TS.ADD('{$R *.dfm}');

TS.ADD('');

TS.ADD('end.');

TS.SaveToFile('D:\unit2.pas');

finally

TS.Free;

end;

这样就可以自动实现动态dfm和pas关联，文件可用于设计和二次开发