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

Posted 2023-04-24

参考技术A

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

　　procedure ObjectTextToBinary（Input Output: TStream）

　　var

　　SaveSeparator: Char;

　　Parser: TParser;

　　Writer: riter;

　　…

　　begin

　　Parser := TParser Create（Input）

　　SaveSeparator := DecimalSeparator;

　　DecimalSeparator := ;

　　try

　　Writer := riter Create（Output ）

　　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[ ] of Char;

　　begin

　　MemoryStream := TMemoryStream Create;

　　try

　　ObjectTextToBinary（Input MemoryStream）

　　MemorySize := MemoryStream Size;

　　FillChar（Header SizeOf（Header） ）

　　MemoryStream Position := SizeOf（Longint） Skip header

　　MemoryStream Read（Len ）

　　if Len and $F = $F then

　　begin

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

　　begin

　　MemoryStream Read（Len ）

　　case TValueType（Len） of

　　vaInt : Len := ;

　　vaInt : Len := ;

　　vaInt : Len := ;

　　end;

　　MemoryStream Read（Tmp Len）

　　end;

　　MemoryStream Read（Len ）

　　end;

　　MemoryStream Read（Header[ ] Len）

　　StrUpper（@Header[ ]）

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

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

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

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

　　Output Write（Header Len + ）

　　Output Write（MemoryStream Memory^ MemorySize）

　　finally

　　MemoryStream Free;

　　end;

　　end;

　 　 动态DFM文件应用揭秘

　　 动态DFM文件概述

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

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

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

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

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

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

　　procedure TForm Button Click（Sender: Tobject）

　　var

　　Ctrl: TControl

　　begin

　　Ctrl := TEdit Create（Self）

　　Ctrl Top := ;

　　Ctrl Left := ;

　　Ctrl Width := ;

　　Ctrl Height := ;

　　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 TMainForm FormCreate（Sender: TObject）

　　begin

　　RegisterClass（TLabel）

　　RegisterClass（TEdit）

　　RegisterClass（TMemo）

　　RegisterClass（TButton）

　　RegisterClass（TPanel）

　　RegisterClass（TPanelP）

　　RegisterClass（TBitBtn）

　　…

　　end;

　　⑵ 创建和插入对象

　　procedure TMDIChild FormClick（Sender: TObject）

　　var

　　Ctrl : TControl;

　　Point: TPoint;

　　begin

　　GetCursorPos（Point）

　　Point := BackGround ScreenToClient（Point）

　　case CurToolIndex of

　　 : begin

　　Ctrl := TLabel Create（self）

　　TLabel（Ctrl） AutoSize := False;

　　TLabel（ctrl） Caption := Label +S;

　　TLabel（ctrl） Name := Label ;

　　TLabel（ctrl） Top := Point Y;

　　TLabel（ctrl） Left := Point X;

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

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

　　TLabel（Ctrl） Color := clWhite;

　　TLabel（Ctrl） Font Color := clBlack;

　　TLabel（Ctrl） Font Name := Roman ;

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

　　TLabel（Ctrl） Font Pitch := fpFixed;

　　TLabel（Ctrl） Enabled := False;

　　TLabel（Ctrl） OnClick := LabelClick;

　　TLabel（Ctrl） OnMouseMove := ReportPos;

　　BackGround InsertControl（Ctrl）

　　CurTool Down := False;

　　CurTool := nil;

　　…

　　end;

　　 : begin

　　Ctrl := TEdit Create（self）

　　TEdit（ctrl） AutoSize := True;

　　TEdit（ctrl） Top := Point Y;

　　TEdit（ctrl） Left := Point X;

　　TEdit（Ctrl） Height := ;

　　BackGround InsertControl（Ctrl）

　　…

　　end;

　　 :

　　…

　　end;

　　end;

　　⑵ 存取动态DFM文件

lishixinzhi/Article/program/Delphi/201311/25089

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

参考技术A

　　function THandleStream Write（const Buffer; Count: Longint） Longint;

　　begin

　　Result := FileWrite（FHandle Buffer Count）

　　if Result = then Result := ;

　　end;

　　Seek方法调用FileSeek函数实现文件指针的移动 其实现如下

　　function THandleStream Seek（Offset: Longint; Origin: Word） Longint;

　　begin

　　Result := FileSeek（FHandle Offset Origin）

　　end;

　　 TFileStream对象

　　TFileStream对象是在磁盘文件上存储数据的Stream对象 TFileStream是从THandleStream继承下来的 它和THandleStream一样都是实现文件的存取操作 不同之处在于THandleStream用句柄访问文件 而TFileStream用文件名访问文件 实际上TFileStream是THandleStream上的一层包装 其内核是THandleStream的属性和方法

　　TFileStream中没有增加新的属性和方法 它只是覆盖了的构造方法Create和析构方法Destory 在Create方法中带两个参数FileName和Mode FileName描述要创建或打开的文件名 而Mode描述文件模式如fmCreate fmOpenRead和fmOpenWrite等 Create方法首先使用FileCreate或FileOpen函数创建或打开名为FileName的文件 再将得到的文件句柄赋给FHandle TFileStream的文件读写操作都是由从THandleStream继承的Read

　　var

　　Stream: TStream;

　　begin

　　Stream := TFileStream Create（FileName fmCreate）

　　try

　　SaveToStream（Stream）

　　finally

　　Stream Free;

　　end;

　　end;

　　在Delphi 的许多对象的SaveToStream 和SaveToFile LoadFromStream和LoadFromFile方法的实现都有类似的嵌套结构

　　 TMemoryStream对象

　　TMemoryStream对象是一个管理动态内存中的数据的Stream对象 它是从TCustomMemoryStream中继承下来的 除了从TCustomMemoryStream中继承的属性和方法外 它还增加和覆盖了一些用于从磁盘文件和其它注台读数据的方法 它还提供了写入 消除内存内容的动态内存管理方法 下面介绍它的这些属性和方法

　　 TMemoryStream的属性和方法

　　 Capacity属性

　　声明

property Copacity: Longint;

　　Capacity属性决定了分配给内存流的内存池的大小 这与Size属性有些不同 Size属性是描述流中数据的大小 在程序中可以将Capacity 的值设置的比数据所需最大内存大一些 这样可以避免频繁地重新分配

　　 Realloc方法

　　声明

function Realloc（var NewCapacity: Longint） Pointer; virtual;

　　Realloc方法 以 K为单位分配动态内存 内存的大小由NewCapacity指定 函数返回指向所分配内存的指针

　　 SetSize方法

　　SetSize方法消除内存流中包含的数据 并将内存流中内存池的大小设为Size字节 如果Size为零 是SetSize方法将释放已有的内存池 并将Memory属性置为nil;否则 SetSize方法将内存池大小调整为Size

　　 Clear方法

　　声明

procedure Clear;

　　Clear方法释放内存中的内存池 并将Memory属性置为nil 在调用Clear方法后 Size和Position属性都为

　　 LoadFromStream方法

　　声明

procedure LoadFromStream（Stream: TStream）

　　LoadFromStream方法将Stream指定的流中的全部内容复制到MemoryStream中 复制过程将取代已有内容 使MemoryStream成为Stream的一份拷贝

　　 LoadFromFile方法

　　声明

procedure LoadFromFile（count FileName: String）

　　LoadFromFile方法将FileName指定文件的所有内容复制到MemoryStream中 并取代已有内容 调用LoadFromFile方法后 MemoryStream将成为文件内容在内存中的完整拷贝

　　 TMemoryStream对象的实现原理

　　TMemoryStream从TCustomMemoryStream对象直接继承 因此可以享用TCustomMemoryStream的属性和方法 前面讲过 TCustomMemoryStream是用于内存中数据操作的抽象对象 它为MemoryStream对象的实现提供了框架 框架中的内容还要由具体MemoryStream对象去填充 TMemoryStream对象就是按动态内存管理的需要填充框架中的具体内容 下面介绍TMemoryStream对象的实现

　 　 TMemoryStream属性的实现

　　TMemoryStream在其protected部分增加了一个Capacity属性 该属性决定了MemoryStream所占动态内存的大小 TMemoryStream首先在private部分声明了FCapacity变量作为存储Capacity属性值的数据域 然后在protected部分声明了该属性 在属性声明的读控制部分简单读取FCapacity的值 在写控制处调用了方法SetCapacity 该方法除了给FCapacity赋值外还执行了修改Capacity属性所必需操作如状态改变等

　　下面是属性的实现

　　TMemoryStream = class（TCustomMemoryStream）

　　private

　　FCapacity: Longint;

　　procedure SetCapacity（NewCapacity: Longint）

　　protected

　　…

　　property Capacity: Longint read FCapacity write SetCapacity;

　　public

　　…

　　end;

　　写控制方法SetCapacity的实现是这样的

　　procedure TMemoryStream SetCapacity（NewCapacity: Longint）

　　begin

　　SetPointer（Realloc（NewCapacity） FSize）

　　FCapacity := NewCapacity;

　　end;

　　在SetCapacity 方法先是调用Realloc重新分配内存 然后用NewCapacity的值给FCapacity赋值 Realloc方法进行某些对象状态的改变

　　 TMemoryStream对象方法的实现

　　⑴ Realloc方法

　　Realloc方法是TMemoryStream动态内存分配的核心 它的SetSize SetCapacity等方法最终都是调用Realloc进行内存的分配和初始化工作的 它的实现如下

　　const

　　MemoryDelta = $ ;

　　function TMemoryStream Realloc（var NewCapacity: Longint） Pointer;

　　begin

　　if NewCapacity > then

　　NewCapacity := （NewCapacity + （MemoryDelta ）） and not （MemoryDelta ）

　　Result := Memory;

　　if NewCapacity <> FCapacity then

　　begin

　　if NewCapacity = then

　　begin

　　GlobalFreePtr（Memory）

　　Result := nil;

　　end else

　　begin

　　if Capacity = then

　　Result := GlobalAllocPtr（HeapAllocFlags NewCapacity）

　　else

　　Result := GlobalReallocPtr（Memory NewCapacity HeapAllocFlags）

　　if Result = nil then raise EStreamError CreateRes（SMemoryStreamError）

　　end;

　　end;

　　end;

　　Realloc方法是以 K为单位分配动态内存的 方法中的第一句if语句就是执行该操作 如果传入的NewCapacity参数值为 则释放流中的内存 Realloc方法用GLobal FreePtr函数释放内存 用GlobalAllocPtr分配内存 用GlobalReallocPtr进行内存的重分配 如果原来的Capacity属性值为 则调用Globa|AllocPtr否则调用GlobalReallocPtr 最后如果Result为nil则触发内存流错的异常事件 否则返回指向分配的内存的指针

lishixinzhi/Article/program/Delphi/201311/25107