DELPHI基礎教程：開發Delphi對象式數據管理功能（五）[3]

　　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） + 處開始 即多了個頭信息

[]  []  []  []  

From:http://tw.wingwit.com/Article/program/Delphi/201311/25090.html