Delphi的“动态窗体”技术实际应用

Delphi的“动态窗体”技术实际应用

锡山飞狐  2003-4-24

 

关键字:Delphi,DFM,窗体

 

为了我可以少敲点字,我们先来看一些资料

==begin================================

DFM文件与标准文本文件转换

  在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:54:28) 得0分

procedure TForm1.Button1Click(Sender: TObject);

begin

Memo1.Text := ComponentToString(Self);

end;

 

回复人: 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个要求。

 

 

实际应用中,一个窗体几乎肯定会有事件处理函数,所以我们要达成第1个要求。我这儿提供了两个方案,各有优缺点:

方案一:

程序员在开发时,在窗体的FormCreate)中,用LoadTextForm生成窗体文件,然后把窗体上的控件全部移到本窗体上,最后查找窗体上的控件,动态设置事件处理函数。这个方法要求有一套好的控件命名规则,而且开发比较烦琐,享受不到DelphiIDE所见即所得,自动生成事件关联代码的好处了。不过对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中调用ReadFormself

这个方案没有第一个方案的限制,但是要求开发人员必须先完成一个完整的Form文件交给Form文件制作人员, Form文件的制作人员不能修改控件的name,不能添加或删除控件,而且必须保留开发人员给定所有事件处理函数,不能修改函数名。不过很多问题可以写一个Form编辑器来保证不出问题。

具体代码就不写了。

我想,肯定还有跟好的方案来解决动态窗体的问题,希望大家讨论。

(以上代码使用Delphi6编写)

最后,我给出一个我实际项目中的有关动态窗体的函数的Unit

{*****************************************

  模块编号:J001DfmFunc

  模块名称:Dfm窗体函数集单元

  作者: 刘爱军

  建立日期:2002122

  最后修改日期:

  说明:本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;

 

procedure 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.

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值