procedure TMainFormFileOpen（Sender: TObject）
begin
if OpenDialogExecute then
begin
DesignWin := TMDIChildCreate（Application）
ReadComponentResFile（OpenDialogFileName DesignWin）
DesignWinInit;
FileName := OpenDialogFileName;
DesignWinCaption := FFileName;
end;
end;
DesignWin是在TMainForm中定义的TMDIChild类型的窗体部件是卡片设计平台FFileName是私有变量用来保存当前编辑的卡片文件名DesignWin的Init方法实现如下
procedure TMDIChildInit;
var
I: Integer;
Ctrl: TControl;
begin
BackGroundBringToFront;
with BackGround do
for I:= to ControlCount do
if Controls[I]Name <> then
ObjectInsObjectListItemsAddObject（Controls[I]Name Controls[I]）
end;
BackGround是TPanel类型的部件所有的动态创建对象都插入到BackGround中所以后面调用BackGroundInsertControl（Ctrl）ObjectIns是个仿Delphi 的媒体属性编辑器
动态DFM文件的存储过程是这样的
procedure TMainFormFileSave（Sender: TObject）
begin
if DesignWinCurControl <> nil then
DesignWinCurControlEnabled := True;
WriteComponentResFile（FFilename DesignWin）
DesignWinCaption := FileName;
end;
end;
因为在DesignWin的Init方法中调用了InsertControl方法所以在关闭DesignWin窗口时要相应地调用RemoveControl否则在关闭DesignWin窗口时会产生内存错误
procedure TMDIChildFormCloseQuery（Sender: TObject; var CanClose: Boolean）
var
I: Integer;
Ctrl: TControl;
Removed: Boolean;
begin
if Modified = True then
if MessageDlg（Close the form? mtConfirmation
[mbOk mbCancel] ） = mrCancel then
CanClose := False;
if CanClose = True then
begin
repeat
removed := False;
I := ;
repeat
if BackGroundControls[I]Name <> then
begin
BackGroundRemoveControl（BackGroundControls[I]）
Removed := True;
end;
I := I +
until （I >= BackGroundControlCount） or （Removed = True）
until （Removed = False）
SendMessage（ObjectInsHandle WM_MDICHILDCLOSED ）
end;
end;
动态DFM文件应用之二超媒体系统脚本语言设计
超媒体脚本语言设计是超媒体系统设计的重要内容脚本语言必须能够表达卡片中的多种媒体对象必须是可编程可理解的必须是可执行的应该可以由脚本语言生成超媒体系统中的卡片和链
DFM文件可以看作是超媒体系统的卡片DFM脚本能够表达DFM文件中的多种控制也就是说能够表达卡片中的多种媒体对象再加上DFM脚本的对象式表达可编辑性可转换为DFM文件因此用作超媒体系统脚本语言较好的形式
ObjectBinaryToText和ObjectTextToBinary过程提供了在部件和DFM脚本之间相互转化的功能ObjectResourceToText和ObjectTextToResoure过程提供了DFM文件和DFM脚本之间相互转化的功能这样就可以在应用程序中自如实现超媒体卡片和超媒体脚本语言相互转化
下面是卡片和脚本语言相互转化的程序
procedure TMDIChildCardToScript;
var
In Out: TStream;
begin
In := TMemoryStreamCreate;
Out := TMemoryStreamCreate;
try
InWriteComponentRes（SelfClassName Self）
ObjectResourceToText（In out）
ScriptFormScriptEditLinesLoadFromStream（Out）
finally
InFree;
OutFree;
end;
end;
ScriptEdit是个文本编辑器它的Lines属性是TStrings类型的对象
procedure TScriptFormScriptToCard;
var
In Out: TStream;
begin
In := TMemoryStreamCreate;
Out := TMemoryStreamCreate;
try
ScriptFormScriptEditLinesSaveToFromStream（In）
ObjectTextToResource（In out）
InReadComponentRes（DesignWin）
finally
InFree;
OutFree;
end;
end;
这两段程序是对整个卡片即窗体级进行转换的ObjectBinaryToText和ObjectTextToBinary过程可以细化到部件级的转换因此超媒体脚本语言的编辑可以细化到媒体对象级
超媒体编辑和表现系统与动态DFM文件的扩展
超媒体系统的媒体编辑与卡片管理有其特殊的需求比如链接需求这时采用已有的窗体部件和媒体部件并按常规的DFM文件处理就显得力不从心了解决这个矛盾有两套方案
● 利用Delphi部件开发技术继承和开发新的部件增加新的超媒体特有的属性和处理方法
● 扩展DFM文件结构使之能按自己的需要任意地存取和转换部件和DFM文件
前者是充分利用Delphi的面向对象部件开发技术在存取和转换等处理上仍旧与常规DFM文件相同而后者需要DFM的存取和转换上作比较大的改动下文介绍扩展DFM文件的思路
扩展动态DFM文件的总体思路是降低处理操作的数据的颗粒度即从原先窗体级降低到部件级
下面是存取操作的扩展示范
var
FileStream: TStream;
I: Integer;
begin
FileStream := TFileStreamCreate（OverViewCrd fmOpenWrite）
With TWriterCreate（FileStream ） do
try
for I := to DesignWinControlCount do
begin
WriteInteger（MMID[i]）
WriteRootComponent（DesignWinControls[i]）
{ 写相应媒体扩展信息 }
……
end;
WriteListEnd;
finally
Free;
end;
FileStreamFree;
end;
WriteInteger（MMID[i]）语句是写入媒体标识
下面是相应的读扩展DFM的程序
var
PropInfo: PPropInfo;
Method : TMethod;
FileStream: TStream;
I: Integer;
begin
FileStream := TFileStreamCreate（OverViewCrd fmOpenRead）
With TReaderCreate（FileStream ） do
try
while not EndOfList do
begin
case ReadInteger of
IDText: begin
Ctrl := TControl（ReadRootComponent（nil））
PropInfo := GetPropInfo（CtrlClassInfo OnClick）
MethodCode:= SelfMethodAddress（MethodName）
MethodData := Self;
if MethodCode <> nil then
SetMethodProp（Ctrl PropInfo Method）
DesignWinInsertControl（Ctrl）
end;
IDImage:
……
end;
……
WriteListEnd;
end;
finally
Free;
end;
FileStreamFree;
end;
SetMethodProp过程是用于重新联接控制和它的事件处理过程类似的功能还可以用TReader对象的OnFindMethod事件的处理过程来实现
实现脚本语言扩展的基本方法与存取扩展类似但它还要加扩展媒体信息转换为文本并插入到部件的脚本描述中
数据库BLOB字段应用
Delphi VCL提供了TBlobStream对象支持对数据库BLOB字段的存取Delphi 的TBlobStream对象的作用在于一方面可以使Delphi应用程序充分利用多媒体数据库的数据管理能力另一方面又能利用Delphi Object Pascal的程序设计能力给关系型多媒体数据库提供底层控制能力和全方位的功能扩展余地
TBlobStream的使用
TBlobStream对象用一个TBlobField类型的对象作为参数来创建与BLOB字段相联的BLOB流接着就可用流的存取方法在BLOB字段中存取数据
var
BlobStream: TBlobStream;
I: Integer;
begin
BlobStream := TBlobStreamCreate（TBlobField（CardTableFields[] bmWrite）
With TWriterCreate（BlobStream ） do
try
for I := to DesignWinControlCount do
begin
WriteInteger（MMID[i]）
WriteRootComponent（DesignWinControls[i]）
{ 写相应媒体扩展信息 }
……
end;
WriteListEnd;
finally
Free;
end;
BlobStreamFree;
CardTablePost;
end;
Fields变量是表示数据库记录的字段数组Fields[]正是数据库的BLOB 字段CardTable的Post方法将数据库的修改反馈到数据库的物理存储上
上面这段程序是超媒体卡片存储的部分源程序我们就是将卡片保存在数据库BLOB字段中实现将超文本和关系数据库两种数据管理方式结合起来读卡片的程序如下
var
PropInfo: PPropInfo;
Method: TMethod;
Blobtream: TStream;
I: Integer;
begin
BlobStream := TBlobStreamCreate（TBlobField（CardTableFields[]） bmRead）
With TReaderCreate（BlobStream ） do
try
while not EndOfList do
begin
case ReadInteger of
IDText: begin
Ctrl := TControl（ReadRootComponent（nil））
PropInfo := GetPropInfo（CtrlClassInfo OnClick）
MethodCode:= SelfMethodAddress（MethodName）
MethodData := Self;
if MethodCode <> nil then
SetMethodProp（Ctrl PropInfo Method）
DesignWinInsertControl（Ctrl）
end;
IDImage:
……
end;
……
WriteListEnd;
end;
finally
Free;
end;
FileStreamFree;
end;
BLOB字段与图形图像
在多媒体数据库中处理得比较多的是图形图像因此早期的多媒体数据库在扩展关系数据库时往往是增加一个图像字段BLOB字段是以二进制数据存储方式因此它完全可以表达图形图像数据
在TBlobField对象中提供了LoadFromBitMap和SaveToBitMap方法存取位图数据它们在实现上都是使用BlobStream对象
procedure TBlobFieldLoadFromBitmap（Bitmap: TBitmap）
var
BlobStream: TBlobStream;
Header: TGraphicHeader;
begin
BlobStream := TBlobStreamCreate（Self bmWrite）
try
if （DataType = ftGraphic） or （DataType = ftTypedBinary） then
begin
HeaderCount := ;
HeaderHType := $;
HeaderSize := ;
BlobStreamWrite（Header SizeOf（Header））
BitmapSaveToStream（BlobStream）
HeaderSize := BlobStreamPosition SizeOf（Header）
BlobStreamPosition := ;
BlobStreamWrite（Header SizeOf（Header））
end else
BitmapSaveToStream（BlobStream）
finally
BlobStreamFree;
end;
end;
procedure TBlobFieldSaveToBitmap（Bitmap: TBitmap）
var
BlobStream: TBlobStream;
Size: Longint;
Header: TGraphicHeader;
begin
BlobStream := TBlobStreamCreate（Self bmRead）
try
Size := BlobStreamSize;
if Size >= SizeOf（TGraphicHeader） then
begin
BlobStreamRead（Header SizeOf（Header））
if （HeaderCount <> ） or （HeaderHType <> $） or
（HeaderSize <> Size SizeOf（Header）） then
BlobStreamPosition := ;
end;
BitmapLoadFromStream（BlobStream）
finally
BlobStreamFree;
end;
end;
程序中按两种方式存取数据对于位图数据数据的起点是流的Potition为处对于图形或其它类型的Blob数据则以流的Position为SizeOf（Header） + 处开始 即多了个头信息
[] [] [] []
![DELPHI基础教程：开发Delphi对象式数据管理功能（五）[3]](/UploadFiles/4.jpg)