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文件

[]  []  []  []  

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