DELPHI基础教程：开发Delphi对象式数据管理功能（五）[2]

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

procedure ObjectTextToBinary（Input Output: TStream）

var

SaveSeparator: Char;

Parser: TParser;

Writer: TWriter;

…

begin

Parser := TParserCreate（Input）

SaveSeparator := DecimalSeparator;

DecimalSeparator := ;

try

Writer := TWriterCreate（Output ）

try

WriterWriteSignature;

ConvertObject;

finally

WriterFree;

end;

finally

DecimalSeparator := SaveSeparator;

ParserFree;

end;

end;

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

procedure ConvertObject;

var

InheritedObject: Boolean;

begin

InheritedObject := False;

if ParserTokenSymbolIs（INHERITED） then

InheritedObject := True

else

ParserCheckTokenSymbol（OBJECT）

ParserNextToken;

ConvertHeader（InheritedObject）

while not ParserTokenSymbolIs（END） and

not ParserTokenSymbolIs（OBJECT） and

not ParserTokenSymbolIs（INHERITED） do ConvertProperty;

WriterWriteListEnd;

while not ParserTokenSymbolIs（END） do ConvertObject;

WriterWriteListEnd;

ParserNextToken;

end;

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

procedure ObjectResourceToText（Input Output: TStream）

begin

InputReadResHeader;

ObjectBinaryToText（Input Output）

end;

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

procedure ObjectTextToResource（Input Output: TStream）

var

Len: Byte;

Tmp: Longint;

MemoryStream: TMemoryStream;

MemorySize: Longint;

Header: array[] of Char;

begin

MemoryStream := TMemoryStreamCreate;

try

ObjectTextToBinary（Input MemoryStream）

MemorySize := MemoryStreamSize;

FillChar（Header SizeOf（Header） ）

MemoryStreamPosition := SizeOf（Longint） { Skip header }

MemoryStreamRead（Len ）

if Len and $F = $F then

begin

if ffChildPos in TFilerFlags（（Len and $F）） then

begin

MemoryStreamRead（Len ）

case TValueType（Len） of

vaInt: Len := ;

vaInt: Len := ;

vaInt: Len := ;

end;

MemoryStreamRead（Tmp Len）

end;

MemoryStreamRead（Len ）

end;

MemoryStreamRead（Header[] Len）

StrUpper（@Header[]）

Byte（（@Header[]）^） := $FF;

Word（（@Header[]）^） := ;

Word（（@Header[Len + ]）^） := $;

Longint（（@Header[Len + ]）^） := MemorySize;

OutputWrite（Header Len + ）

OutputWrite（MemoryStreamMemory^ MemorySize）

finally

MemoryStreamFree;

end;

end;

动态DFM文件应用揭秘

动态DFM文件概述

动态DFM文件是相对于静态DFM文件而言所谓静态DFM文件是指在Delphi开发环境中设计的窗体文件窗体的设计过程就是程序的编制过程因此动态DFM文件就是指在程序运行过程生成或存取的DFM文件

动态DFM文件的创建和使用分别如下两种情况

● 在程序运行过程中由Create方法动态生成窗体或部件然后动态生成其它部件插入其中生成DFM文件

● 在Delphi开发环境中设计生成DFM文件然后用DFM 文件存取函数或者用Stream对象和Filer对象的方法将DFM文件读入内存进行处理最后又存入磁盘中

由Delphi的窗体设计的常规方法生成的DFM文件在程序运行一开始就规定了部件的结构因为在窗体设计过程中窗体中的每个部件都在程序的对象声明中定义了部件变量这种固定的结构虽然能方便应用但以牺牲灵活性为代价

在Delphi应用程序中有时需要在运行过程中创建控制然后将该控制插入另一个部件中例如

procedure TFormButtonClick（Sender: Tobject）

var

Ctrl: TControl

begin

Ctrl := TEditCreate（Self）

CtrlTop := ;

CtrlLeft := ;

CtrlWidth := ;

CtrlHeight := ;

InsertControl（Ctrl）

end;

动态插入控制的优点是可以在任何时刻任意位置插入任意数量的任何类型的控制因为应用程序需求在很多情况下是在程序运行中才知道的所以动态插入控制就显得很重要而且在很多情况下需要保存这些界面元素留待程序再次调用例如应用程序界面的定制系统状态的保存对话框的保存等这时生成动态DFM文件是最佳选择

动态插入控制的不足之处是在插入控制前无法直观地看到控制的大小风格位置等也就是动态插入控制的过程是非可视化的但可以借助于静态DFM文件的可视化设计这就是生成和使用动态DFM文件的第二种方法也就是在应用程序运行前在Delphi开发环境中使用可视化开发工具设计所需窗口或部件的样式以DFM文件保存然后在应用程序运行过程中将DFM文件读入内存Delphi的Stream对象和Filer对象在读取DFM文件时会根据DFM文件的内容自动创建部件及其拥有的所有部件

在使用动态DFM文件时有两点需要注意

● 每一个动态插入的控制或部件必须在程序中调用RegisterClass进行注册

● 读入DFM文件自动创建部件后如果调用了InsertControl方法 则在关闭窗口时要调用RemoveControl方法移去该控制否则会产生异常事件

动态DFM文件应用之一超媒体系统的卡片设计

Delphi多种类型的可视部件如文本部件编辑部件图形图像部件数据库部件媒体媒放部件和OLE部件等每一种部件在屏幕中占据一定的区域具有相当丰富的表现能力可以作为卡片中的一种媒体因此可以利用这些可视部件进行超媒体系统的卡片设计

超媒体卡片设计要求卡片中的媒体数目和媒体种类是不受限制的而且必须能够修改和存取卡片因此采用动态DFM文件是比较合适的而且如果利用Stream对象将卡片存储在数据库BLOB字段中就为把超文本与关系数据库技术结合起来创造了契机

下面是超媒体卡片设计子系统中的部分源程序它演示了如何创建对象插入对象和存取动态DFM文件

⑴ 在应用程序中注册对象

procedure TMainFormFormCreate（Sender: TObject）

begin

RegisterClass（TLabel）

RegisterClass（TEdit）

RegisterClass（TMemo）

RegisterClass（TButton）

RegisterClass（TPanel）

RegisterClass（TPanelP）

RegisterClass（TBitBtn）

…

end;

⑵ 创建和插入对象

procedure TMDIChildFormClick（Sender: TObject）

var

Ctrl : TControl;

Point: TPoint;

begin

GetCursorPos（Point）

Point := BackGroundScreenToClient（Point）

case CurToolIndex of

: begin

Ctrl := TLabelCreate（self）

TLabel（Ctrl）AutoSize := False;

TLabel（ctrl）Caption := Label+S;

TLabel（ctrl）Name := Label ;

TLabel（ctrl）Top := PointY;

TLabel（ctrl）Left := PointX;

TLabel（Ctrl）Height := Round（*Res//Ratio）

TLabel（Ctrl）Width := Round（*Res//Ratio）

TLabel（Ctrl）Color := clWhite;

TLabel（Ctrl）FontColor := clBlack;

TLabel（Ctrl）FontName := Roman;

TLabel（Ctrl）FontHeight := TLabel（Ctrl）Height;

TLabel（Ctrl）FontPitch := fpFixed;

TLabel（Ctrl）Enabled := False;

TLabel（Ctrl）OnClick := LabelClick;

TLabel（Ctrl）OnMouseMove := ReportPos;

BackGroundInsertControl（Ctrl）

CurToolDown := False;

CurTool := nil;

…

end;

: begin

Ctrl := TEditCreate（self）

TEdit（ctrl）AutoSize := True;

TEdit（ctrl）Top := PointY;

TEdit（ctrl）Left := PointX;

TEdit（Ctrl）Height := ;

BackGroundInsertControl（Ctrl）

…

end;

:

…

end;

end;

⑵ 存取动态DFM文件

[] [] [] []