Delphi的“動態窗體”技術實際應用??
日期：2005年6月1日?? 作者：On2008?? 人氣：613?? 查看:[大字體?? 中字體?? 小字體]????
在Delphi可視化設計環境中，允許程序員在代碼編輯器中以文本的方式瀏覽和修改DFM文件內容。當用File/Open命令直接打開DFM文件或者選擇窗體設計窗口的彈出式菜單上的View?? as?? Text命令時，就會在編輯器中出現文本形式的信息。在一些資料中將這種文本形式稱之為窗體設計腳本。Delphi提供的這種腳本編輯功能是對Delphi可視化設計的一大補充。當然這個腳本編輯能力是有限制的，比方說不能在腳本任意地添加和刪除部件，因為代碼和DFM腳本是緊密相連的，任意添加和修改會導致不一致性。但在動態生成的DFM文件中，就不存在這一限制。
　　實際上，DFM文件內容是二進制數據，它的腳本是經過Delphi開發環境自動轉化的，而且Delphi?? VCL中的Classes庫單元提供了在二進制流中的文件DFM和它的腳本之相互轉化的過程。它們是ObjectBinaryToText和ObjectTextToBinary、ObjectResourceToText和ObjectTextToResource。
　　ObjectBinaryToText過程將二進制流中存儲的部件轉化為基于文本的表現形式，這樣就可以用文本處理函數進行處理，還可以用文本編輯器進行查找和替代操作，最后可以將文本再轉化成二進制流中的部件。
　　ObjectTextToBinary過程執行的功能與ObjectBinaryToText相反，將TXT文件轉換為二進制流中的部件，而且只要TXT文件內容的書寫符合DFM腳本語法，ObjectTextToBinary可將任何程序生成的TXT文件轉換為部件，這一功能也為DFM文件的動態生成和編輯奠定了基礎。

如何在運行過程中將本窗體保存成一個文本格式的.dfm文件？
zswang(伴水)　(2001-11-21?? 9:52:59)?? 得0分
function?? ComponentToString(Component:?? TComponent):?? string;
var
BinStream:?? TMemoryStream;
StrStream:?? TStringStream;
s:?? string;
begin
BinStream?? :=?? TMemoryStream.Create;
try
StrStream?? :=?? TStringStream.Create(s);
try
BinStream.WriteComponent(Component);
BinStream.Seek(0,?? soFromBeginning);
ObjectBinaryToText(BinStream,?? StrStream);
StrStream.Seek(0,?? soFromBeginning);
Result?? :=?? StrStream.DataString;
finally
StrStream.Free;
end;
finally
BinStream.Free
end;
end;?? {?? ComponentToString?? }
function?? StringToComponent(Value:?? string;?? Instance:?? TComponent):?? TComponent;
var
StrStream:?? TStringStream;
BinStream:?? TMemoryStream;
begin
StrStream?? :=?? TStringStream.Create(Value);
try
BinStream?? :=?? TMemoryStream.Create;
try
ObjectTextToBinary(StrStream,?? BinStream);
BinStream.Seek(0,?? soFromBeginning);
Result?? :=?? BinStream.ReadComponent(Instance);
finally
BinStream.Free;
end;
finally
StrStream.Free;
end;
end;?? {?? StringToComponent?? }
　
回復人：　zswang(伴水)　(2001-11-21?? 9:58:13)?? 得0分
procedure?? TForm1.Button2Click(Sender:?? TObject);
begin
StringToComponent(
'object?? Label1:?? TLabel '#13#10?? +
'?? Left?? =?? 232 '#13#10?? +
'?? Top?? =?? 56 '#13#10?? +
'?? Width?? =?? 26 '#13#10?? +
'?? Height?? =?? 13 '#13#10?? +
'?? Caption?? =?? #20320#22909 '#13#10?? +
'?? Font.Charset?? =?? GB2312_CHARSET '#13#10?? +
'?? Font.Color?? =?? clRed '#13#10?? +
'?? Font.Height?? =?? -13 '#13#10?? +
'?? Font.Name?? =?? #23435#20307 '#13#10?? +
'?? Font.Style?? =?? [] '#13#10?? +
'?? ParentFont?? =?? False '#13#10?? +
'end '#13#10,?? Label1);
end;
//要注冊類
＝＝end＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
好了，理解了上面的這段文字，一些朋友就會自然想到，利用這幾個函數應該可以弄出點有用的東西出來，我就弄出了一點應用，并全面應用到了項目中，現在我來給大家完整描述出來：
首先我要求我的程序有如下能力：
1.?? 我的程序的窗體是可以動態替換的，不用編譯Exe，只要替換一個DFM窗體設計腳本就可以了（當然，你可以重新包裝一下這個DFM文件，比如換成txt后綴名等）。
2.?? 我可以預覽所有的DFM文件，讓它變成實際的Form察看。
不要小看這兩點，在很多情況下，這意義非常重大，舉幾個例子①開發階段，可以把界面設計和程序設計完全分開，分工進行②現場維護時，有些界面的調整和功能設置不需要再找源代碼到Delphi下去編譯一遍了，老出差做Mis類的朋友應該能從這點體會出好處③某些功能界面的升級簡單了不少，只要讓用戶下載一個DFM文件覆蓋原來的就可以了。
好，不費話了，下面詳細說明怎么達到以上兩點要求。
顯然我們要讓一段文本變成一個Form，那么就用這個函數：
function?? StringToComponent(Value:?? string;?? Instance:TComponent):?? TComponent;
var
StrStream:TStringStream;
BinStream:?? TMemoryStream;
begin
StrStream?? :=?? TStringStream.Create(Value);
try
BinStream?? :=?? TMemoryStream.Create;
try
ObjectTextToBinary(StrStream,?? BinStream);
BinStream.Seek(0,?? soFromBeginning);
Result?? :=?? BinStream.ReadComponent(Instance);
finally
BinStream.Free;
end;
finally
StrStream.Free;
end;
end;
但是，所有的Class必須是注冊過的，例如，如下的Form1FRM.DFM文件
object?? Form1:?? TForm1
Left?? =?? 222
Top?? =?? 168
Width?? =?? 485
Height?? =?? 290
Caption?? =?? 'Form1 '
Color?? =?? clBtnFace
Font.Charset?? =?? DEFAULT_CHARSET
Font.Color?? =?? clWindowText
Font.Height?? =?? -11
Font.Name?? =?? 'MS?? Sans?? Serif '
Font.Style?? =?? []
OldCreateOrder?? =?? False
PixelsPerInch?? =?? 96
TextHeight?? =?? 13
object?? Panel1:?? TPanel
Left?? =?? 0
Top?? =?? 0
Width?? =?? 477
Height?? =?? 33
Align?? =?? alTop
TabOrder?? =?? 0
object?? BitBtn1:?? TBitBtn
Left?? =?? 4
Top?? =?? 4
Width?? =?? 75
Height?? =?? 25
Caption?? =?? 'OK '
TabOrder?? =?? 0
end
end
object?? Memo1:?? TMemo
Left?? =?? 0
Top?? =?? 33
Width?? =?? 477
Height?? =?? 230
Align?? =?? alClient
TabOrder?? =?? 1
end
end
你應該這么使用，
var?? list:TstringList;form:TForm
…
list.Lines.LoadFromFile(‘Form1FRM.DFM’);
RegisterClass(TForm1);
RegisterClass(TPanel);
RegisterClass(TBitBtn);
RegisterClass(TMemo);
form?? :=?? StringToComponent(list.Lines.Text,nil);
form.ShowModal();
…
這樣就能顯示出一個窗體了。
但是這有個問題，Delphi自帶的VCL控件是固定的，用RegisterClass（…）注冊一遍沒有問題，可TForm1不是，如果連TForm1都要注冊的話，就無法達成第2點要求。我們可以變通一下，因為所有的Form都是從Tform繼承的，所以，應該都可以用注冊Tform來取代，因此，有了下面這樣一個函數：
function?? LoadTextForm(FileName:String):TForm;
var
list:TStrings;
FirstLine:String;
iPos?? :?? Integer;
Form?? :?? TForm;
begin
Result?? :=?? nil;
if?? FileExists(FileName)=False?? then
Exit;
Form?? :=?? TForm.Create(Application);
list?? :=?? TStringList.Create;
try
list.LoadFromFile(FileName);
if?? list.Count=0?? then
Exit;
FirstLine?? :=?? list[0];
iPos?? :=?? Pos( ':?? ',FirstLine);
if?? iPos?? =?? 0?? then?? //找不到 ':?? '，格式不對
Exit;
list[0]:=Copy(FirstLine,1,iPos)+ '?? TForm ';
DeleteErrorLines(list);
StringToComponent(list.Text,Form);
Result?? :=?? Form;
except
Form.Free;
Result?? :=?? nil;
end;
list.Free;
end;
原理就是讀入DFM文件后把窗體的類別偷換成Tform。其中還有一個函數：
procedure?? DeleteErrorLines(list:TStrings);
var
i:Integer;
line:String;
begin
if?? list.Count=0?? then
Exit;

i:=0;
while?? i <list.Count?? do
begin
line?? :=?? Trim(list[i]);
if?? Copy(line,1,2)= 'On '?? then
list.Delete(i)
else
Inc(i);
end;
end;
這個函數是把凡是含有“On”開頭的行刪除，應為在Delphi中，所有控件的事件都是以“On”開頭，刪除了這樣的行，就能保證StringToComponent(list.Text,Form);不出錯，用以上的兩個函數就可以寫一個DFM窗體察看器了，到目前為止，我還沒有搜到哪個人發布了DFM窗體察看器。這樣我們就完成了第2個要求。

?
?
?
對我有用[0]丟個板磚[0]引用舉報管理TOP精華推薦：想做一個所見即所得的html編輯器 誰有這方面技術資料 謝謝了?

xthmpro_cn
([可人])

等　級：

?#5樓 得分：0回復于：2005-06-27 08:57:54實際應用中，一個窗體幾乎肯定會有事件處理函數，所以我們要達成第1個要求。我這兒提供了兩個方案，各有優缺點：
方案一：
程序員在開發時，在窗體的FormCreate（…）中，用LoadTextForm（…）生成窗體文件，然后把窗體上的控件全部移到本窗體上，最后查找窗體上的控件，動態設置事件處理函數。這個方法要求有一套好的控件命名規則，而且開發比較煩瑣，享受不到Delphi的IDE所見即所得，自動生成事件關聯代碼的好處了。不過對Form文件的制作人員限制很小，他們可以直接用Delphi來制作窗體。
方案二：
用這個函數
procedure?? ReadForm(aFrom?? :?? TComponent;aFileName?? :string= ' ');
var
FrmStrings?? :?? TStrings;
begin
RegisterClass(TPersistentClass(aFrom.ClassType));
FrmStrings:=TStringlist.Create?? ;
try
if?? trim(aFileName)= ' '?? then?? FrmStrings.LoadFromFile(?? gsPathInfo+ '\ '+aFrom.Name+ '.txt ')
else?? FrmStrings.LoadFromFile(aFileName);
while?? aFrom.ComponentCount> 0?? do?? aFrom.Components[0].Destroy?? ;
aFrom:=StringToComponent(FrmStrings.Text,aFrom)
finally
FrmStrings.Free;
end;
UnRegisterClass(TPersistentClass(aFrom.ClassType));
end;
在FormCreate中調用ReadForm（self，…）。
這個方案沒有第一個方案的限制，但是要求開發人員必須先完成一個完整的Form文件交給Form文件制作人員，?? Form文件的制作人員不能修改控件的name，不能添加或刪除控件，而且必須保留開發人員給定所有事件處理函數，不能修改函數名。不過很多問題可以寫一個Form編輯器來保證不出問題。
具體代碼就不寫了。
我想，肯定還有跟好的方案來解決動態窗體的問題，希望大家討論。
（以上代碼使用Delphi6編寫）
最后，我給出一個我實際項目中的有關動態窗體的函數的Unit
{*****************************************
模塊編號：J001DfmFunc
模塊名稱：Dfm窗體函數集單元
作者：劉愛軍
建立日期：2002年12月2日
最后修改日期：
說明：本Unit包含了一些函數，用于根據Delphi窗體文件格式的文件動態創建窗體
*******************************************}

unit?? J001DfmFunc;

interface

uses
Windows,?? Messages,?? SysUtils,?? Variants,?? Classes,?? Graphics,?? Controls,?? Forms,
Dialogs,?? ExtCtrls,?? DBCtrls,?? Grids,?? DBGrids,?? Buttons,?? StdCtrls,
ComCtrls,dbcgrids,?? buttonComps,Tabs,QryGlobal;

type
TAllComponentClass?? =?? Array?? of?? TPersistentClass;

procedure?? InitClassType(ClassArray:TAllComponentClass);

function?? ComponentToString(Component:?? TComponent):?? string;
function?? StringToComponent(Value:?? string;?? Instance:TComponent):?? TComponent;
procedure?? RegisterAllClasses(aAllCmpClass:TAllComponentClass);
procedure?? UnRegisterAllClasses(aAllCmpClass:TAllComponentClass);
function?? GetObjectString(list:TStrings;BegLine:Integer=0;TypeString:string= ' '):string;
function?? LoadTextForm(FileName:String):TForm;
function?? LoadTextForm2(FileName:String;out?? ErrMsg:string):TForm;
procedure?? DeleteErrorLines(list:TStrings);
procedure?? ReadForm(aFrom?? :?? TComponent;aFileName?? :string= ' ');
const
RegisteredCompoentClassCount?? =?? 32;//數組大小

var
AllCmpClass?? :?? TAllComponentClass;?? //存放控件類

implementation

//初始化可以解析的類，可隨需要增加
procedure?? InitClassType(ClassArray:TAllComponentClass);
begin
SetLength(AllCmpClass,RegisteredCompoentClassCount);
AllCmpClass[0]?? :=?? TForm;
AllCmpClass[1]?? :=?? TGroupBox;
AllCmpClass[2]?? :=?? TPanel;
AllCmpClass[3]?? :=?? TScrollBox;
AllCmpClass[4]?? :=?? TLabel;
AllCmpClass[5]?? :=?? TButton;
AllCmpClass[6]?? :=?? TBitBtn;
AllCmpClass[7]?? :=?? TSpeedButton;
AllCmpClass[8]?? :=?? TStringGrid;
AllCmpClass[9]?? :=?? TImage;
AllCmpClass[10]?? :=?? TBevel;
AllCmpClass[11]?? :=?? TStaticText;
AllCmpClass[12]?? :=?? TTabControl;
AllCmpClass[13]?? :=?? TPageControl;
AllCmpClass[14]?? :=?? TTabSheet;
AllCmpClass[15]?? :=?? TDBNavigator;
AllCmpClass[16]?? :=?? TDBText;
AllCmpClass[17]?? :=?? TDBEdit;
AllCmpClass[18]?? :=?? TDBMemo;
AllCmpClass[19]?? :=?? TDBGrid;
AllCmpClass[20]?? :=?? TDBCtrlGrid;
AllCmpClass[21]?? :=?? TMemo;
AllCmpClass[22]?? :=?? TSplitter;
AllCmpClass[23]?? :=?? TCheckBox;
AllCmpClass[24]?? :=?? TEdit;
AllCmpClass[25]?? :=?? TListBox;
AllCmpClass[26]?? :=?? TComboBox;
AllCmpClass[27]?? :=?? TDateTimePicker;
AllCmpClass[28]?? :=?? TImageButton;
AllCmpClass[29]?? :=?? TTabSet;
AllCmpClass[30]?? :=?? TTreeView;
AllCmpClass[31]?? :=?? TListView;

end;
?
?
對我有用[0]丟個板磚[0]引用舉報管理TOP精華推薦：這樣算不算線程死鎖狀態

xthmpro_cn
([可人])

等　級：

?#6樓 得分：0回復于：2005-06-27 08:58:14procedure?? RegisterAllClasses(aAllCmpClass:TAllComponentClass);
var
i:Integer;
begin
for?? i:=0?? to?? RegisteredCompoentClassCount-1?? do
RegisterClass(aAllCmpClass[i]);
end;

procedure?? UnRegisterAllClasses(aAllCmpClass:TAllComponentClass);
var
i:Integer;
begin
for?? i:=0?? to?? RegisteredCompoentClassCount-1?? do
UnRegisterClass(aAllCmpClass[i]);
end;

function?? ComponentToString(Component:?? TComponent):?? string;
var
BinStream:TMemoryStream;
StrStream:?? TStringStream;
s:?? string;
begin
BinStream?? :=?? TMemoryStream.Create;
try
StrStream?? :=?? TStringStream.Create(s);
try
BinStream.WriteComponent(Component);
BinStream.Seek(0,?? soFromBeginning);
ObjectBinaryToText(BinStream,?? StrStream);
StrStream.Seek(0,?? soFromBeginning);
Result:=?? StrStream.DataString;
finally
StrStream.Free;

end;
finally
BinStream.Free
end;
end;

function?? StringToComponent(Value:?? string;?? Instance:TComponent):?? TComponent;
var
StrStream:TStringStream;
BinStream:?? TMemoryStream;
begin
StrStream?? :=?? TStringStream.Create(Value);
try
BinStream?? :=?? TMemoryStream.Create;
try
ObjectTextToBinary(StrStream,?? BinStream);
BinStream.Seek(0,?? soFromBeginning);
Result?? :=?? BinStream.ReadComponent(Instance);

finally
BinStream.Free;
end;
finally
StrStream.Free;
end;
end;

function?? GetObjectString(list:TStrings;BegLine:Integer=0;TypeString:string= ' '):string;
var
i,iBegCount,iEndCount:Integer;
ObjString,Line,ClassStr:String;
begin
iBegCount:=0;
iEndCount:=0;
ClassStr?? :=?? Trim(UpperCase(TypeString));
for?? i:=BegLine?? to?? list.Count-1?? do
begin
line?? :=?? UpperCase(list[i]);
if?? Pos( 'OBJECT ',line)> 0?? then
begin
if?? (TypeString= ' ')?? or?? (Pos( ':?? '+ClassStr,line)> 0)?? then
Inc(iBegCount);
end
else?? if?? (iBegCount> iEndCount)?? and?? (trim(line)= 'END ')?? then
Inc(iEndCount);

if?? iBegCount> 0?? then
Result?? :=?? Result?? +?? list[i]?? +?? #13#10;

if?? (iBegCount> 0)?? and?? (iBegCount=iEndCount)?? then
Exit;
end;
end;

procedure?? DeleteErrorLines(list:TStrings);
var
i:Integer;
line:String;
begin
if?? list.Count=0?? then
Exit;

i:=0;
while?? i <list.Count?? do
begin
line?? :=?? Trim(list[i]);
if?? Copy(line,1,2)= 'On '?? then
list.Delete(i)
else
Inc(i);
end;
end;
procedure?? ReadForm(aFrom?? :?? TComponent;aFileName?? :string= ' ');
var
FrmStrings?? :?? TStrings;
begin
RegisterClass(TPersistentClass(aFrom.ClassType));
FrmStrings:=TStringlist.Create?? ;
try
if?? trim(aFileName)= ' '?? then?? FrmStrings.LoadFromFile(?? gsPathInfo+ '\ '+aFrom.Name+ '.txt ')
else?? FrmStrings.LoadFromFile(aFileName);
while?? aFrom.ComponentCount> 0?? do?? aFrom.Components[0].Destroy?? ;
aFrom:=StringToComponent(FrmStrings.Text,aFrom)
finally
FrmStrings.Free;
end;
UnRegisterClass(TPersistentClass(aFrom.ClassType));
end;
function?? LoadTextForm(FileName:String):TForm;
var
list:TStrings;
FirstLine:String;
iPos?? :?? Integer;
Form?? :?? TForm;
begin
Result?? :=?? nil;

if?? FileExists(FileName)=False?? then
Exit;

Form?? :=?? TForm.Create(Application);
list?? :=?? TStringList.Create;
try
list.LoadFromFile(FileName);
if?? list.Count=0?? then
Exit;

FirstLine?? :=?? list[0];
iPos?? :=?? Pos( ':?? ',FirstLine);
if?? iPos?? =?? 0?? then?? //找不到 ':?? '，格式不對
Exit;

list[0]:=Copy(FirstLine,1,iPos)+ '?? TForm ';

DeleteErrorLines(list);

StringToComponent(list.Text,Form);
Result?? :=?? Form;
except
Form.Free;
Result?? :=?? nil;
end;
list.Free;
end;
function?? LoadTextForm2(FileName:String;out?? ErrMsg:string):TForm;
var
list:TStrings;
FirstLine:String;
iPos?? :?? Integer;
Form?? :?? TForm;
begin
Result?? :=?? nil;

if?? FileExists(FileName)=False?? then
begin
ErrMsg?? :=?? '無效的文件名！ ';
Exit;
end;

Form?? :=?? TForm.Create(Application);
list?? :=?? TStringList.Create;
try
list.LoadFromFile(FileName);
if?? list.Count=0?? then
Exit;

FirstLine?? :=?? list[0];
iPos?? :=?? Pos( ':?? ',FirstLine);
if?? iPos?? =?? 0?? then?? //找不到 ':?? '，格式不對
begin
ErrMsg?? :=?? '找不到 ' ':?? ' '，文件格式不對 ';
Exit;
end;

list[0]:=Copy(FirstLine,1,iPos)+ '?? TForm ';

DeleteErrorLines(list);

StringToComponent(list.Text,Form);
Result?? :=?? Form;
except
on?? e:exception?? do
begin
Form.Free;
Result?? :=?? nil;
ErrMsg?? :=?? '讀入文件錯誤: '+e.Message;
end;
end;
list.Free;
end;

initialization
begin
InitClassType(AllCmpClass);
RegisterAllClasses(AllCmpClass);
end;
finalization
UnRegisterAllClasses(AllCmpClass);
end.?

總結

以上是生活随笔為你收集整理的Delphi的“动态窗体”技术实际应用[网络摘抄]的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。