|
 |
栏目导栏 |
|
| |
|
|
|
|
|
资料搜索 |
|
| |
|
|
|
|
|
热门文章 |
|
| |
|
|
|
|
|
最新文章 |
|
| |
|
|
|
| |
| |
|
|
|
|
在Delphi可视化设计环境中，允许程序员在代码编辑器中以文本的方式浏览和修改DFM文件内容。当用File/Open命令直接打开DFM文件或者选择窗体设计窗口的弹出式菜单上的View as Text命令时，就会在编辑器中出现文本形式的信息。在一些资料中将这种文本形式称之为窗体设计脚本。Delphi提供的这种脚本编辑功能是对Delphi可视化设计的一大补充。当然这个脚本编辑能力是有限制的，比方说不能在脚本任意地添加和删除部件，因为代码和DFM脚本是紧密相连的，任意添加和修改会导致不一致性。但在动态生成的DFM文件中，就不存在这一限制。DnrLinux联盟
实际上，DFM文件内容是二进制数据，它的脚本是经过Delphi开发环境自动转化的，而且Delphi VCL中的Classes库单元提供了在二进制流中的文件DFM和它的脚本之相互转化的过程。它们是ObjectBinaryToText和ObjectTextToBinary、ObjectResourceToText和ObjectTextToResource。DnrLinux联盟
ObjectBinaryToText过程将二进制流中存储的部件转化为基于文本的表现形式，这样就可以用文本处理函数进行处理，还可以用文本编辑器进行查找和替代操作，最后可以将文本再转化成二进制流中的部件。DnrLinux联盟
ObjectTextToBinary过程执行的功能与ObjectBinaryToText相反，将TXT文件转换为二进制流中的部件，而且只要TXT文件内容的书写符合DFM脚本语法，ObjectTextToBinary可将任何程序生成的TXT文件转换为部件，这一功能也为DFM文件的动态生成和编辑奠定了基础。DnrLinux联盟
DnrLinux联盟
如何在运行过程中将本窗体保存成一个文本格式的.dfm文件？DnrLinux联盟
DnrLinux联盟
function ComponentToString(Component: TComponent): string;DnrLinux联盟
varDnrLinux联盟
BinStream: TMemoryStream;DnrLinux联盟
StrStream: TStringStream;DnrLinux联盟
s: string;DnrLinux联盟
beginDnrLinux联盟
BinStream := TMemoryStream.Create;DnrLinux联盟
tryDnrLinux联盟
StrStream := TStringStream.Create(s);DnrLinux联盟
tryDnrLinux联盟
BinStream.WriteComponent(Component);DnrLinux联盟
BinStream.Seek(0, soFromBeginning);DnrLinux联盟
ObjectBinaryToText(BinStream, StrStream);DnrLinux联盟
StrStream.Seek(0, soFromBeginning);DnrLinux联盟
Result := StrStream.DataString;DnrLinux联盟
finallyDnrLinux联盟
StrStream.Free;DnrLinux联盟
end;DnrLinux联盟
finallyDnrLinux联盟
BinStream.FreeDnrLinux联盟
end;DnrLinux联盟
end; { ComponentToString }DnrLinux联盟
function StringToComponent(Value: string; Instance: TComponent): TComponent;DnrLinux联盟
varDnrLinux联盟
StrStream: TStringStream;DnrLinux联盟
BinStream: TMemoryStream;DnrLinux联盟
beginDnrLinux联盟
StrStream := TStringStream.Create(Value);DnrLinux联盟
tryDnrLinux联盟
BinStream := TMemoryStream.Create;DnrLinux联盟
tryDnrLinux联盟
ObjectTextToBinary(StrStream, BinStream);DnrLinux联盟
BinStream.Seek(0, soFromBeginning);DnrLinux联盟
Result := BinStream.ReadComponent(Instance);DnrLinux联盟
finallyDnrLinux联盟
BinStream.Free;DnrLinux联盟
end;DnrLinux联盟
finallyDnrLinux联盟
StrStream.Free;DnrLinux联盟
end;DnrLinux联盟
end; { StringToComponent }DnrLinux联盟
DnrLinux联盟
DnrLinux联盟
procedure TForm1.Button1Click(Sender: TObject);DnrLinux联盟
beginDnrLinux联盟
Memo1.Text := ComponentToString(Self);DnrLinux联盟
end;DnrLinux联盟
DnrLinux联盟
DnrLinux联盟
procedure TForm1.Button2Click(Sender: TObject);DnrLinux联盟
beginDnrLinux联盟
StringToComponent(DnrLinux联盟
‘object Label1: TLabel‘#13#10 +DnrLinux联盟
‘ Left = 232‘#13#10 +DnrLinux联盟
‘ Top = 56‘#13#10 +DnrLinux联盟
‘ Width = 26‘#13#10 +DnrLinux联盟
‘ Height = 13‘#13#10 +DnrLinux联盟
‘ Caption = #20320#22909‘#13#10 +DnrLinux联盟
‘ Font.Charset = GB2312_CHARSET‘#13#10 +DnrLinux联盟
‘ Font.Color = clRed‘#13#10 +DnrLinux联盟
‘ Font.Height = -13‘#13#10 +DnrLinux联盟
‘ Font.Name = #23435#20307‘#13#10 +DnrLinux联盟
‘ Font.Style = []‘#13#10 +DnrLinux联盟
‘ ParentFont = False‘#13#10 +DnrLinux联盟
‘end‘#13#10, Label1);DnrLinux联盟
end;DnrLinux联盟
//要注册类DnrLinux联盟
＝＝end＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝DnrLinux联盟
好了，理解了上面的这段文字，一些朋友就会自然想到，利用这几个函数应该可以弄出点有用的东西出来，我就弄出了一点应用，并全面应用到了项目中，现在我来给大家完整描述出来：DnrLinux联盟
DnrLinux联盟
首先我要求我的程序有如下能力：DnrLinux联盟
1. 我的程序的窗体是可以动态替换的，不用编译Exe，只要替换一个DFM窗体设计脚本就可以了（当然，你可以重新包装一下这个DFM文件，比如换成txt后缀名等）。DnrLinux联盟
2. 我可以预览所有的DFM文件，让它变成实际的Form察看。DnrLinux联盟
不要小看这两点，在很多情况下，这意义非常重大，举几个例子①开发阶段，可以把界面设计和程序设计完全分开，分工进行②现场维护时，有些界面的调整和功能设置不需要再找源代码到Delphi下去编译一遍了，老出差做Mis类的朋友应该能从这点体会出好处③某些功能界面的升级简单了不少，只要让用户下载一个DFM文件覆盖原来的就可以了。DnrLinux联盟
好，不费话了，下面详细说明怎么达到以上两点要求。DnrLinux联盟
显然我们要让一段文本变成一个Form，那么就用这个函数：DnrLinux联盟
function StringToComponent(Value: string; Instance:TComponent): TComponent;DnrLinux联盟
varDnrLinux联盟
StrStream:TStringStream;DnrLinux联盟
BinStream: TMemoryStream;DnrLinux联盟
beginDnrLinux联盟
StrStream := TStringStream.Create(Value);DnrLinux联盟
tryDnrLinux联盟
BinStream := TMemoryStream.Create;DnrLinux联盟
tryDnrLinux联盟
ObjectTextToBinary(StrStream, BinStream);DnrLinux联盟
BinStream.Seek(0, soFromBeginning);DnrLinux联盟
Result := BinStream.ReadComponent(Instance);DnrLinux联盟
finallyDnrLinux联盟
BinStream.Free;DnrLinux联盟
end;DnrLinux联盟
finallyDnrLinux联盟
StrStream.Free;DnrLinux联盟
end;DnrLinux联盟
end;DnrLinux联盟
但是，所有的Class必须是注册过的，例如，如下的Form1FRM.DFM文件DnrLinux联盟
object Form1: TForm1DnrLinux联盟
Left = 222DnrLinux联盟
Top = 168DnrLinux联盟
Width = 485DnrLinux联盟
Height = 290DnrLinux联盟
Caption = ‘Form1‘DnrLinux联盟
Color = clBtnFaceDnrLinux联盟
Font.Charset = DEFAULT_CHARSETDnrLinux联盟
Font.Color = clWindowTextDnrLinux联盟
Font.Height = -11DnrLinux联盟
Font.Name = ‘MS Sans Serif‘DnrLinux联盟
Font.Style = []DnrLinux联盟
OldCreateOrder = FalseDnrLinux联盟
PixelsPerInch = 96DnrLinux联盟
TextHeight = 13DnrLinux联盟
object Panel1: TPanelDnrLinux联盟
Left = 0DnrLinux联盟
Top = 0DnrLinux联盟
Width = 477DnrLinux联盟
Height = 33DnrLinux联盟
Align = alTopDnrLinux联盟
TabOrder = 0DnrLinux联盟
object BitBtn1: TBitBtnDnrLinux联盟
Left = 4DnrLinux联盟
Top = 4DnrLinux联盟
Width = 75DnrLinux联盟
Height = 25DnrLinux联盟
Caption = ‘OK‘DnrLinux联盟
TabOrder = 0DnrLinux联盟
endDnrLinux联盟
endDnrLinux联盟
object Memo1: TMemoDnrLinux联盟
Left = 0DnrLinux联盟
Top = 33DnrLinux联盟
Width = 477DnrLinux联盟
Height = 230DnrLinux联盟
Align = alClientDnrLinux联盟
TabOrder = 1DnrLinux联盟
endDnrLinux联盟
endDnrLinux联盟
你应该这么使用，DnrLinux联盟
var list:TstringList;form:TFormDnrLinux联盟
…DnrLinux联盟
list.Lines.LoadFromFile(‘Form1FRM.DFM’);DnrLinux联盟
RegisterClass(TForm1);DnrLinux联盟
RegisterClass(TPanel);DnrLinux联盟
RegisterClass(TBitBtn);DnrLinux联盟
RegisterClass(TMemo);DnrLinux联盟
form := StringToComponent(list.Lines.Text,nil);DnrLinux联盟
form.ShowModal();DnrLinux联盟
…DnrLinux联盟
这样就能显示出一个窗体了。DnrLinux联盟
但是这有个问题，Delphi自带的VCL控件是固定的，用RegisterClass（…）注册一遍没有问题，可TForm1不是，如果连TForm1都要注册的话，就无法达成第2点要求。我们可以变通一下，因为所有的Form都是从Tform继承的，所以，应该都可以用注册Tform来取代，因此，有了下面这样一个函数：DnrLinux联盟
function LoadTextForm(FileName:String):TForm;DnrLinux联盟
varDnrLinux联盟
list:TStrings;DnrLinux联盟
FirstLine:String;DnrLinux联盟
iPos : Integer;DnrLinux联盟
Form : TForm;DnrLinux联盟
beginDnrLinux联盟
Result := nil;DnrLinux联盟
if FileExists(FileName)=False thenDnrLinux联盟
Exit;DnrLinux联盟
Form := TForm.Create(Application);DnrLinux联盟
list := TStringList.Create;DnrLinux联盟
tryDnrLinux联盟
list.LoadFromFile(FileName);DnrLinux联盟
if list.Count=0 thenDnrLinux联盟
Exit;DnrLinux联盟
FirstLine := list[0];DnrLinux联盟
iPos := Pos(‘: ‘,FirstLine);DnrLinux联盟
if iPos = 0 then //找不到‘: ‘，格式不对DnrLinux联盟
Exit;DnrLinux联盟
list[0]:=Copy(FirstLine,1,iPos)+‘ TForm‘;DnrLinux联盟
DeleteErrorLines(list);DnrLinux联盟
StringToComponent(list.Text,Form);DnrLinux联盟
Result := Form;DnrLinux联盟
exceptDnrLinux联盟
Form.Free;DnrLinux联盟
Result := nil;DnrLinux联盟
end;DnrLinux联盟
list.Free;DnrLinux联盟
end;DnrLinux联盟
原理就是读入DFM文件后把窗体的类别偷换成Tform。其中还有一个函数：DnrLinux联盟
procedure DeleteErrorLines(list:TStrings);DnrLinux联盟
varDnrLinux联盟
i:Integer;DnrLinux联盟
line:String;DnrLinux联盟
beginDnrLinux联盟
if list.Count=0 thenDnrLinux联盟
Exit;DnrLinux联盟
DnrLinux联盟
i:=0;DnrLinux联盟
while i<list.Count doDnrLinux联盟
beginDnrLinux联盟
line := Trim(list[i]);DnrLinux联盟
if Copy(line,1,2)=‘On‘ thenDnrLinux联盟
list.Delete(i)DnrLinux联盟
elseDnrLinux联盟
Inc(i);DnrLinux联盟
end;DnrLinux联盟
end;DnrLinux联盟
这个函数是把凡是含有“On”开头的行删除，应为在Delphi中，所有控件的事件都是以“On”开头，删除了这样的行，就能保证StringToComponent(list.Text,Form);不出错，用以上的两个函数就可以写一个DFM窗体察看器了，到目前为止，我还没有搜到哪个人发布了DFM窗体察看器。这样我们就完成了第2个要求。DnrLinux联盟
DnrLinux联盟
DnrLinux联盟
实际应用中，一个窗体几乎肯定会有事件处理函数，所以我们要达成第1个要求。我这儿提供了两个方案，各有优缺点：DnrLinux联盟
方案一：DnrLinux联盟
程序员在开发时，在窗体的FormCreate（…）中，用LoadTextForm（…）生成窗体文件，然后把窗体上的控件全部移到本窗体上，最后查找窗体上的控件，动态设置事件处理函数。这个方法要求有一套好的控件命名规则，而且开发比较烦琐，享受不到Delphi的IDE所见即所得，自动生成事件关联代码的好处了。不过对Form文件的制作人员限制很小，他们可以直接用Delphi来制作窗体。DnrLinux联盟
方案二：DnrLinux联盟
用这个函数DnrLinux联盟
procedure ReadForm(aFrom : TComponent;aFileName :string=‘‘);DnrLinux联盟
varDnrLinux联盟
FrmStrings : TStrings;DnrLinux联盟
beginDnrLinux联盟
RegisterClass(TPersistentClass(aFrom.ClassType));DnrLinux联盟
FrmStrings:=TStringlist.Create ;DnrLinux联盟
tryDnrLinux联盟
if trim(aFileName)=‘‘ then FrmStrings.LoadFromFile( gsPathInfo+‘‘+aFrom.Name+‘.txt‘)DnrLinux联盟
else FrmStrings.LoadFromFile(aFileName);DnrLinux联盟
while aFrom.ComponentCount>0 do aFrom.Components[0].Destroy ;DnrLinux联盟
aFrom:=StringToComponent(FrmStrings.Text,aFrom)DnrLinux联盟
finallyDnrLinux联盟
FrmStrings.Free;DnrLinux联盟
end;DnrLinux联盟
UnRegisterClass(TPersistentClass(aFrom.ClassType));DnrLinux联盟
end;DnrLinux联盟
在FormCreate中调用ReadForm（self，…）。DnrLinux联盟
这个方案没有第一个方案的限制，但是要求开发人员必须先完成一个完整的Form文件交给Form文件制作人员， Form文件的制作人员不能修改控件的name，不能添加或删除控件，而且必须保留开发人员给定所有事件处理函数，不能修改函数名。不过很多问题可以写一个Form编辑器来保证不出问题。DnrLinux联盟
具体代码就不写了。DnrLinux联盟
我想，肯定还有跟好的方案来解决动态窗体的问题，希望大家讨论。DnrLinux联盟
（以上代码使用Delphi6编写）DnrLinux联盟
最后，我给出一个我实际项目中的有关动态窗体的函数的UnitDnrLinux联盟
{*****************************************DnrLinux联盟
模块编号：J001DfmFuncDnrLinux联盟
模块名称：Dfm窗体函数集单元DnrLinux联盟
作者：刘爱军DnrLinux联盟
建立日期：2002年12月2日DnrLinux联盟
最后修改日期：DnrLinux联盟
说明：本Unit包含了一些函数，用于根据Delphi窗体文件格式的文件动态创建窗体DnrLinux联盟
*******************************************}DnrLinux联盟
DnrLinux联盟
unit J001DfmFunc;DnrLinux联盟
DnrLinux联盟
interfaceDnrLinux联盟
DnrLinux联盟
usesDnrLinux联盟
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,DnrLinux联盟
Dialogs, ExtCtrls, DBCtrls, Grids, DBGrids, Buttons, StdCtrls,DnrLinux联盟
ComCtrls,dbcgrids, buttonComps,Tabs,QryGlobal;DnrLinux联盟
DnrLinux联盟
typeDnrLinux联盟
TAllComponentClass = Array of TPersistentClass;DnrLinux联盟
DnrLinux联盟
procedure InitClassType(ClassArray:TAllComponentClass);DnrLinux联盟
DnrLinux联盟
function ComponentToString(Component: TComponent): string;DnrLinux联盟
function StringToComponent(Value: string; Instance:TComponent): TComponent;DnrLinux联盟
procedure RegisterAllClasses(aAllCmpClass:TAllComponentClass);DnrLinux联盟
procedure UnRegisterAllClasses(aAllCmpClass:TAllComponentClass);DnrLinux联盟
function GetObjectString(list:TStrings;BegLine:Integer=0;TypeString:string=‘‘):string;DnrLinux联盟
function LoadTextForm(FileName:String):TForm;DnrLinux联盟
function LoadTextForm2(FileName:String;out ErrMsg:string):TForm;DnrLinux联盟
procedure DeleteErrorLines(list:TStrings);DnrLinux联盟
procedure ReadForm(aFrom : TComponent;aFileName :string=‘‘);DnrLinux联盟
constDnrLinux联盟
RegisteredCompoentClassCount = 32;//数组大小DnrLinux联盟
DnrLinux联盟
varDnrLinux联盟
AllCmpClass : TAllComponentClass; //存放控件类DnrLinux联盟
DnrLinux联盟
implementationDnrLinux联盟
DnrLinux联盟
//初始化可以解析的类，可随需要增加DnrLinux联盟
procedure InitClassType(ClassArray:TAllComponentClass);DnrLinux联盟
beginDnrLinux联盟
SetLength(AllCmpClass,RegisteredCompoentClassCount);DnrLinux联盟
AllCmpClass[0] := TForm;DnrLinux联盟
AllCmpClass[1] := TGroupBox;DnrLinux联盟
AllCmpClass[2] := TPanel;DnrLinux联盟
AllCmpClass[3] := TScrollBox;DnrLinux联盟
AllCmpClass[4] := TLabel;DnrLinux联盟
AllCmpClass[5] := TButton;DnrLinux联盟
AllCmpClass[6] := TBitBtn;DnrLinux联盟
AllCmpClass[7] := TSpeedButton;DnrLinux联盟
AllCmpClass[8] := TStringGrid;DnrLinux联盟
AllCmpClass[9] := TImage;DnrLinux联盟
AllCmpClass[10] := TBevel;DnrLinux联盟
AllCmpClass[11] := TStaticText;DnrLinux联盟
AllCmpClass[12] := TTabControl;DnrLinux联盟
AllCmpClass[13] := TPageControl;DnrLinux联盟
AllCmpClass[14] := TTabSheet;DnrLinux联盟
AllCmpClass[15] := TDBNavigator;DnrLinux联盟
AllCmpClass[16] := TDBText;DnrLinux联盟
AllCmpClass[17] := TDBEdit;DnrLinux联盟
AllCmpClass[18] := TDBMemo;DnrLinux联盟
AllCmpClass[19] := TDBGrid;DnrLinux联盟
AllCmpClass[20] := TDBCtrlGrid;DnrLinux联盟
AllCmpClass[21] := TMemo;DnrLinux联盟
AllCmpClass[22] := TSplitter;DnrLinux联盟
AllCmpClass[23] := TCheckBox;DnrLinux联盟
AllCmpClass[24] := TEdit;DnrLinux联盟
AllCmpClass[25] := TListBox;DnrLinux联盟
AllCmpClass[26] := TComboBox;DnrLinux联盟
AllCmpClass[27] := TDateTimePicker;DnrLinux联盟
AllCmpClass[28] := TImageButton;DnrLinux联盟
AllCmpClass[29] := TTabSet;DnrLinux联盟
AllCmpClass[30] := TTreeView;DnrLinux联盟
AllCmpClass[31] := TListView;DnrLinux联盟
DnrLinux联盟
end;DnrLinux联盟
DnrLinux联盟
procedure RegisterAllClasses(aAllCmpClass:TAllComponentClass);DnrLinux联盟
varDnrLinux联盟
i:Integer;DnrLinux联盟
beginDnrLinux联盟
for i:=0 to RegisteredCompoentClassCount-1 doDnrLinux联盟
RegisterClass(aAllCmpClass[i]);DnrLinux联盟
end;DnrLinux联盟
DnrLinux联盟
procedure UnRegisterAllClasses(aAllCmpClass:TAllComponentClass);DnrLinux联盟
varDnrLinux联盟
i:Integer;DnrLinux联盟
beginDnrLinux联盟
for i:=0 to RegisteredCompoentClassCount-1 doDnrLinux联盟
UnRegisterClass(aAllCmpClass[i]);DnrLinux联盟
end;DnrLinux联盟
DnrLinux联盟
function ComponentToString(Component: TComponent): string;DnrLinux联盟
varDnrLinux联盟
BinStream:TMemoryStream;DnrLinux联盟
StrStream: TStringStream;DnrLinux联盟
s: string;DnrLinux联盟
beginDnrLinux联盟
BinStream := TMemoryStream.Create;DnrLinux联盟
tryDnrLinux联盟
StrStream := TStringStream.Create(s);DnrLinux联盟
tryDnrLinux联盟
BinStream.WriteComponent(Component);DnrLinux联盟
BinStream.Seek(0, soFromBeginning);DnrLinux联盟
ObjectBinaryToText(BinStream, StrStream);DnrLinux联盟
StrStream.Seek(0, soFromBeginning);DnrLinux联盟
Result:= StrStream.DataString;DnrLinux联盟
finallyDnrLinux联盟
StrStream.Free;DnrLinux联盟
DnrLinux联盟
end;DnrLinux联盟
finallyDnrLinux联盟
BinStream.FreeDnrLinux联盟
end;DnrLinux联盟
end;DnrLinux联盟
DnrLinux联盟
function StringToComponent(Value: string; Instance:TComponent): TComponent;DnrLinux联盟
varDnrLinux联盟
StrStream:TStringStream;DnrLinux联盟
BinStream: TMemoryStream;DnrLinux联盟
beginDnrLinux联盟
StrStream := TStringStream.Create(Value);DnrLinux联盟
tryDnrLinux联盟
BinStream := TMemoryStream.Create;DnrLinux联盟
tryDnrLinux联盟
ObjectTextToBinary(StrStream, BinStream);DnrLinux联盟
BinStream.Seek(0, soFromBeginning);DnrLinux联盟
Result := BinStream.ReadComponent(Instance);DnrLinux联盟
DnrLinux联盟
finallyDnrLinux联盟
BinStream.Free;DnrLinux联盟
end;DnrLinux联盟
finallyDnrLinux联盟
StrStream.Free;DnrLinux联盟
end;DnrLinux联盟
end;DnrLinux联盟
DnrLinux联盟
function GetObjectString(list:TStrings;BegLine:Integer=0;TypeString:string=‘‘):string;DnrLinux联盟
varDnrLinux联盟
i,iBegCount,iEndCount:Integer;DnrLinux联盟
ObjString,Line,ClassStr:String;DnrLinux联盟
beginDnrLinux联盟
iBegCount:=0;DnrLinux联盟
iEndCount:=0;DnrLinux联盟
ClassStr := Trim(UpperCase(TypeString));DnrLinux联盟
for i:=BegLine to list.Count-1 doDnrLinux联盟
beginDnrLinux联盟
line := UpperCase(list[i]);DnrLinux联盟
if Pos(‘OBJECT‘,line)>0 thenDnrLinux联盟
beginDnrLinux联盟
if (TypeString=‘‘) or (Pos(‘: ‘+ClassStr,line)>0) thenDnrLinux联盟
Inc(iBegCount);DnrLinux联盟
endDnrLinux联盟
else if (iBegCount>iEndCount) and (trim(line)=‘END‘) thenDnrLinux联盟
Inc(iEndCount);DnrLinux联盟
DnrLinux联盟
if iBegCount>0 thenDnrLinux联盟
Result := Result + list[i] + #13#10;DnrLinux联盟
DnrLinux联盟
if (iBegCount>0) and (iBegCount=iEndCount) thenDnrLinux联盟
Exit;DnrLinux联盟
end;DnrLinux联盟
end;DnrLinux联盟
DnrLinux联盟
procedure DeleteErrorLines(list:TStrings);DnrLinux联盟
varDnrLinux联盟
i:Integer;DnrLinux联盟
line:String;DnrLinux联盟
beginDnrLinux联盟
if list.Count=0 thenDnrLinux联盟
Exit;DnrLinux联盟
DnrLinux联盟
i:=0;DnrLinux联盟
while i<list.Count doDnrLinux联盟
beginDnrLinux联盟
line := Trim(list[i]);DnrLinux联盟
if Copy(line,1,2)=‘On‘ thenDnrLinux联盟
list.Delete(i)DnrLinux联盟
elseDnrLinux联盟
Inc(i);DnrLinux联盟
end;DnrLinux联盟
end;DnrLinux联盟
procedure ReadForm(aFrom : TComponent;aFileName :string=‘‘);DnrLinux联盟
varDnrLinux联盟
FrmStrings : TStrings;DnrLinux联盟
beginDnrLinux联盟
RegisterClass(TPersistentClass(aFrom.ClassType));DnrLinux联盟
FrmStrings:=TStringlist.Create ;DnrLinux联盟
tryDnrLinux联盟
if trim(aFileName)=‘‘ then FrmStrings.LoadFromFile( gsPathInfo+‘‘+aFrom.Name+‘.txt‘)DnrLinux联盟
else FrmStrings.LoadFromFile(aFileName);DnrLinux联盟
while aFrom.ComponentCount>0 do aFrom.Components[0].Destroy ;DnrLinux联盟
aFrom:=StringToComponent(FrmStrings.Text,aFrom)DnrLinux联盟
finallyDnrLinux联盟
FrmStrings.Free;DnrLinux联盟
end;DnrLinux联盟
UnRegisterClass(TPersistentClass(aFrom.ClassType));DnrLinux联盟
end;DnrLinux联盟
function LoadTextForm(FileName:String):TForm;DnrLinux联盟
varDnrLinux联盟
list:TStrings;DnrLinux联盟
FirstLine:String;DnrLinux联盟
iPos : Integer;DnrLinux联盟
Form : TForm;DnrLinux联盟
beginDnrLinux联盟
Result := nil;DnrLinux联盟
DnrLinux联盟
if FileExists(FileName)=False thenDnrLinux联盟
Exit;DnrLinux联盟
DnrLinux联盟
Form := TForm.Create(Application);DnrLinux联盟
list := TStringList.Create;DnrLinux联盟
tryDnrLinux联盟
list.LoadFromFile(FileName);DnrLinux联盟
if list.Count=0 thenDnrLinux联盟
Exit;DnrLinux联盟
DnrLinux联盟
FirstLine := list[0];DnrLinux联盟
iPos := Pos(‘: ‘,FirstLine);DnrLinux联盟
if iPos = 0 then //找不到‘: ‘，格式不对DnrLinux联盟
Exit;DnrLinux联盟
DnrLinux联盟
list[0]:=Copy(FirstLine,1,iPos)+‘ TForm‘;DnrLinux联盟
DnrLinux联盟
DeleteErrorLines(list);DnrLinux联盟
DnrLinux联盟
StringToComponent(list.Text,Form);DnrLinux联盟
Result := Form;DnrLinux联盟
exceptDnrLinux联盟
Form.Free;DnrLinux联盟
Result := nil;DnrLinux联盟
end;DnrLinux联盟
list.Free;DnrLinux联盟
end;DnrLinux联盟
function LoadTextForm2(FileName:String;out ErrMsg:string):TForm;DnrLinux联盟
varDnrLinux联盟
list:TStrings;DnrLinux联盟
FirstLine:String;DnrLinux联盟
iPos : Integer;DnrLinux联盟
Form : TForm;DnrLinux联盟
beginDnrLinux联盟
Result := nil;DnrLinux联盟
DnrLinux联盟
if FileExists(FileName)=False thenDnrLinux联盟
beginDnrLinux联盟
ErrMsg := ‘无效的文件名！‘;DnrLinux联盟
Exit;DnrLinux联盟
end;DnrLinux联盟
DnrLinux联盟
Form := TForm.Create(Application);DnrLinux联盟
list := TStringList.Create;DnrLinux联盟
tryDnrLinux联盟
list.LoadFromFile(FileName);DnrLinux联盟
if list.Count=0 thenDnrLinux联盟
Exit;DnrLinux联盟
DnrLinux联盟
FirstLine := list[0];DnrLinux联盟
iPos := Pos(‘: ‘,FirstLine);DnrLinux联盟
if iPos = 0 then //找不到‘: ‘，格式不对DnrLinux联盟
beginDnrLinux联盟
ErrMsg := ‘找不到‘‘: ‘‘，文件格式不对‘;DnrLinux联盟
Exit;DnrLinux联盟
end;DnrLinux联盟
DnrLinux联盟
list[0]:=Copy(FirstLine,1,iPos)+‘ TForm‘;DnrLinux联盟
DnrLinux联盟
DeleteErrorLines(list);DnrLinux联盟
DnrLinux联盟
StringToComponent(list.Text,Form);DnrLinux联盟
Result := Form;DnrLinux联盟
exceptDnrLinux联盟
on e:exception doDnrLinux联盟
beginDnrLinux联盟
Form.Free;DnrLinux联盟
Result := nil;DnrLinux联盟
ErrMsg := ‘读入文件错误:‘+e.Message;DnrLinux联盟
end;DnrLinux联盟
end;DnrLinux联盟
list.Free;DnrLinux联盟
end;DnrLinux联盟
DnrLinux联盟
DnrLinux联盟
initializationDnrLinux联盟
beginDnrLinux联盟
InitClassType(AllCmpClass);DnrLinux联盟
RegisterAllClasses(AllCmpClass);DnrLinux联盟
end;DnrLinux联盟
DnrLinux联盟
finalizationDnrLinux联盟
UnRegisterAllClasses(AllCmpClass);DnrLinux联盟
DnrLinux联盟
end.DnrLinux联盟
Linux联盟收集整理 ,转贴请标明原始链接,如有任何疑问欢迎来本站Linux论坛讨论 |
|
|
|
|
|
