写DFM文件的过程:WriteComponentResFie

本文介绍了DFM文件的读写方法及与TXT文件的转换过程,包括写入DFM文件的WriteComponentResFile过程、读取DFM文件的ReadComponentResFile函数、内部读取资源中的部件函数InternalReadComponentRes及DFM文件与TXT文件相互转换的方法。

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

   该过程带有两个参数FileName和Instance。FileName参数指定要写入的DFM文件名,Instance参数是TComponent类型的,它指定要写入的部件名,一般是TForm对象的子类。该过程将Instance部件和其拥有的所有部件写入DFM文件。

  这个过程的意义在于,可以在程序运行过程中产生Delphi的窗体部件和在窗体中插入部件,并由该函数将窗体写入DFM文件,支持了动态DFM文件的重用性。

  该过程的程序是这样的:

 

procedure WriteComponentResFile(const FileName: string;Instance: TComponent);

var

Stream: TStream;

begin

Stream := TFileStream.Create(FileName, fmCreate);

try

Stream.WriteComponentRes(Instance.ClassName, Instance);

finally

Stream.Free;

end;

end;

 

  函数中,用FileStream创建文件,用Stream对象的WriteComponetRes方法将Instance写入流中。

 

20.3.1.2 读DFM文件的函数:ReadComponentResFile

 

ReadComponentResFile函数带有两个参数FileName和Instance。FileName参数指定要读DFM文件名,Instance参数指定从DFM文件中要读的部件。该函数从DFM文件中将Instance和它拥有的所有部件,并返回该部件。

  这个函数的意义在于,配合WriteComponentResFile过程的使用支持DFM文件的重用性。

  该函数的程序是这样的:

 

function ReadComponentResFile(const FileName: string;Instance: TComponent):

TComponent;

var

Stream: TStream;

begin

Stream := TFileStream.Create(FileName, fmOpenRead);

try

Result := Stream.ReadComponentRes(Instance);

finally

Stream.Free;

end;

end;

 

  程序中使用FileStream对象打开由FileName指定的DFM文件,然后用Stream对象的ReadComponentRes方法读出Instance,并将读的结果作为函数的返回值。

 

20.3.1.3 读取Delphi应用程序资源中的部件

 

  函数InternalReadComponentRes可以读取Delphi应用程序资源中的部件。Delphi的DFM文件在程序经过编译链接后被嵌入应用程序的资源中,而且格式发生了改变,即少了资源文件头。

在第一节中曾经介绍过TResourceStream对象,该对象是操作资源媒介上的数据的。函数InternalReadComponentRes用了TResourceStream。程序是这样的:

 

function InternalReadComponentRes(const ResName: string;

var Instance: TComponent): Boolean;

var

HRsrc: THandle;

begin { 避免“EResNotFound”异常事件的出现 }

HRsrc := FindResource(HInstance, PChar(ResName), RT_RCDATA);

Result := HRsrc <> 0;

if not Result then Exit;

FreeResource(HRsrc);

with TResourceStream.Create(HInstance, ResName, RT_RCDATA) do

try

Instance := ReadComponent(Instance);

finally

Free;

end;

Result := True;

end;

 

  HInstance是一个Delphi VCL定义的全局变量,代表当前应用程序的句柄。函数用了资源访问API函数FindResource来测定是否存在ResName所描述资源。因为在TResourceStream的创建过程还有FindResource等操作,所以函数中调用了FreeResource。最后函数调用了Stream对象的ReadComponent方法读出部件。因为函数的Instance是var类型的参数,所以可以访问Instance,得到读出的部件。

 

20.3.1.4 DFM文件与标准文本文件(TXT文件)的相互转换

 

  在Delphi可视化设计环境中,允许程序员在代码编辑器中以文本的方式浏览和修改DFM文件内容。当用File/Open命令直接打开DFM文件或者选择窗体设计窗口的弹出式菜单上的View as Text命令时,就会在编辑器中出现文本形式的信息。我们姑且将这种文本形式称之为窗体设计脚本。Delphi提供的这种脚本编辑功能是对Delphi可视化设计的一大补充。当然这个脚本编辑能力是有限制的,比方说不能在脚本任意地添加和删除部件,因为代码和DFM脚本是紧密相连的,任意添加和修改会导致不一致性。然而在动态生成的DFM文件中,就不存在这一限制,后面会介绍DFM动态生成技术的应用。

  实际上,DFM文件内容是二进制数据,它的脚本是经过Delphi开发环境自动转化的,而且Delphi VCL中的Classes库单元中提供了在二进制流中的文件DFM和它的脚本之相互转化的过程。它们是ObjectBinaryToText和ObjectTextBinary、ObjectResourceToText和ObjectTextToResource。

ObjectBinaryToText过程将二进制流中存储的部件转化为基于文本的表现形式,这样就可以用文本处理函数进行处理,还可以用文本编辑器进行查找和替代操作,最后可以将文本再转化成二进制流中的部件。

  ObjectBinaryToText过程的主程序是这样的:

 

procedure ObjectBinaryToText(Input, Output: TStream);

var

NestingLevel: Integer;

SaveSeparator: Char;

Reader: TReader;

Writer: TWriter;

 

procedure WriteIndent;

const

Blanks: array[0..1] of Char = ' ';

var

I: Integer;

begin

for I := 1 to NestingLevel do Writer.Write(Blanks, SizeOf(Blanks));

end;

 

procedure WriteStr(const S: string);

begin

Writer.Write(S[1], Length(S));

end;

 

procedure NewLine;

begin

WriteStr(#13#10);

WriteIndent;

end;

 

procedure ConvertHeader;

begin

end;

 

procedure ConvertBinary;

begin

end;

 

procedure ConvertValue;

begin

end;

 

procedure ConvertProperty;

begin

end;

 

procedure ConvertObject;

begin

end;

 

begin

NestingLevel := 0;

Reader := TReader.Create(Input, 4096);

SaveSeparator := DecimalSeparator;

DecimalSeparator := '.';

try

Writer := TWriter.Create(Output, 4096);

try

Reader.ReadSignature;

ConvertObject;

finally

Writer.Free;

end;

finally

DecimalSeparator := SaveSeparator;

Reader.Free;

end;

end;

 

  过程中调用的ConvertObject过程是个递归过程,用于将DFM文件中的每一个部件转化为文本形式。因为由于部件的拥有关系,所以部件成嵌套结构,采用递归是最好的方式:

 

procedure ConvertObject;

begin

ConvertHeader;

Inc(NestingLevel);

while not Reader.EndOfList do ConvertProperty;

Reader.ReadListEnd;

while not Reader.EndOfList do ConvertObject;

Reader.ReadListEnd;

Dec(NestingLevel);

WriteIndent;

WriteStr('end'#13#10);

end;

 

  NestStingLevel变量表示部件的嵌套层次。WriteIndent是写入每一行起始字符前的空格,ConvertHeader过程是处理部件的继承标志信息。转换成的头信息文本有两种形式。

  InheritedTestForm1: TTestForm[2]

  或者:

Object TestForm1: TTestForm

 

前者是ffInherited和ffChildPos置位,后面是都没置位。

  ConvertProperty过程用于转化属性。

 

procedure ConvertProperty;

begin

WriteIndent;

WriteStr(Reader.ReadStr);

WriteStr(' = ');

ConvertValue;

WriteStr(#13#10);

end;

 

  WriteIndent语句写入属性名前的空格,WriteStr(Reader.ReadStr)语句写入属性名ConvertValue过程根据属性的类型将属性值转化为字符串,然后写入流中。

  ObjectTextToBinary过程执行的功能与ObjectBinaryToText相反,将TXT文件转换为二进制流中的部件,而且只要TXT文件内容的书写符合DFM脚本语法,ObjectTextToBinary可将任何程序生成的TXT文件转换为部件,这一功能也为DFM 文件的动态生成和编辑奠定了基础。ObjectTextToBinary过程的主程序如下:

 

procedure ObjectTextToBinary(Input, Output: TStream);

var

SaveSeparator: Char;

Parser: TParser;

Writer: TWriter;

 

  …

  

begin

Parser := TParser.Create(Input);

SaveSeparator := DecimalSeparator;

DecimalSeparator := '.';

try

Writer := TWriter.Create(Output, 4096);

try

Writer.WriteSignature;

ConvertObject;

finally

Writer.Free;

end;

finally

DecimalSeparator := SaveSeparator;

Parser.Free;

end;

end;

 

  在程序流程和结构上与ObjectBinaryToText差不多。ConvertObject也是个递归过程:

 

procedure ConvertObject;

var

InheritedObject: Boolean;

begin

InheritedObject := False;

if Parser.TokenSymbolIs('INHERITED') then

InheritedObject := True

else

Parser.CheckTokenSymbol('OBJECT');

Parser.NextToken;

ConvertHeader(InheritedObject);

while not Parser.TokenSymbolIs('END') and

not Parser.TokenSymbolIs('OBJECT') and

not Parser.TokenSymbolIs('INHERITED') do ConvertProperty;

Writer.WriteListEnd;

while not Parser.TokenSymbolIs('END') do ConvertObject;

Writer.WriteListEnd;

Parser.NextToken;

end;

 

  DFM文件与DFM脚本语言之间相互转换的任务由ObjectResourceToText和ObjextTextToResource两个过程完成。

 

procedure ObjectResourceToText(Input, Output: TStream);

begin

Input.ReadResHeader;

ObjectBinaryToText(Input, Output);

end;

 

ObjectTextToResource过程就比较复杂,因为DFM文件资源头中要包含继承标志信息,因此在调用ObjectTextToBinary后,就读取标志信息,然后写入资源头。

 

procedure ObjectTextToResource(Input, Output: TStream);

var

Len: Byte;

Tmp: Longint;

MemoryStream: TMemoryStream;

MemorySize: Longint;

Header: array[0..79] of Char;

begin

MemoryStream := TMemoryStream.Create;

try

ObjectTextToBinary(Input, MemoryStream);

MemorySize := MemoryStream.Size;

FillChar(Header, SizeOf(Header), 0);

MemoryStream.Position := SizeOf(Longint); { Skip header }

MemoryStream.Read(Len, 1);

if Len and $F0 = $F0 then

begin

if ffChildPos in TFilerFlags((Len and $F0)) then

begin

MemoryStream.Read(Len, 1);

case TValueType(Len) of

vaInt8: Len := 1;

vaInt16: Len := 2;

vaInt32: Len := 4;

end;

MemoryStream.Read(Tmp, Len);

end;

MemoryStream.Read(Len, 1);

end;

MemoryStream.Read(Header[3], Len);

StrUpper(@Header[3]);

Byte((@Header[0])^) := $FF;

Word((@Header[1])^) := 10;

Word((@Header[Len + 4])^) := $1030;

Longint((@Header[Len + 6])^) := MemorySize;

Output.Write(Header, Len + 10);

Output.Write(MemoryStream.Memory^, MemorySize);

finally

MemoryStream.Free;

end;

end;

文件: ActnList CreateAction 函数 创建一个指定类型的Action,显示在action list editor中。 EnumRegisteredAction 过程 枚举已经注册的Action RegisterAction 过程 注册Action UnRegisterAction 过程 反注册Action 文件: Classes Bounds 函数 输入上下高宽返回一个矩形结构。 CollectionsEqual 函数 比较两个TCollection是不是相等。 CurrentGroup 变量 FindClass 函数 从输入字符串中返回一个从TPersistent继承的类 FindGlobalComponent 变量 返回一个最高阶的容器类。 GetClass 函数 返回一个已经注册了的从TPersistent继承的类 LineStart 函数 返回下一行的开始字符位置 ObjectBinaryToText 过程 转换对象的二进制流形式到文件。 ObjectResourceToText 过程 转换对象的二进制资源到文件。 ObjectTextToBinary 过程 转换保存对象的文件形式到二进制流。 ObjectTextToResource 过程 转换保存对象的文件形式到资源。 Point 函数 输入X,y坐标返回一个点结构。 ReadComponentRes 函数 从窗口资源中读出一个控件和她的属性。 ReadComponentResEx 函数 同上 ReadComponentResFile 函数 从窗口资源文件中读出一个控件和她的属性。 Rect 函数 输入上下左右返回一个矩形结构 RegisterClass 过程 注册一个从TPersistent继承的类,使她的类的类型能够被识别。 RegisterClassAlias 过程 注册一个和另一个除了名字外都相同的类。 RegisterClasses 过程 注册一组类 RegisterComponents 过程 注册一组控件 RegisterIntegerConsts 过程 RegisterNoIcon 过程 注册一组没有图标的控件 RegisterNonActiveX 过程 防止一组控件被ActiveX wizard识别。 UnregisterClass 过程 反注册一个类 UnregisterClasses 过程 反注册一组类 UnregisterModuleClasses 过程 反注册定义在模块中的所有的类 WriteComponentResFile 过程 控件和她的属性到文件文件: Clipbrd Clipboard 函数 返回一个TClipboard对象 SetClipboard 函数 用一个新TClipboard替换全局TClipboard。
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值