有个文本文件,保存着控件的名称及其他属性,如名称      类型     Top    Left    
edtName  TEdit    100    120  
edtPass  TEdit    180    120如何读取文本文件后,根据文本文件中的内容生成控件并布局在窗口中?
读文件没有问题,但如何根据类型生成各种控件?即字符串如何转换成类。
求较完整的例。多谢各位老大帮忙!

解决方案 »

  1.   

    但如何根据类型生成各种控件?即字符串如何转换成类。
    求较完整的例。多谢各位老大帮忙!
    --------------
    什么意思
    你可以直接根据字符串来判断然后动态生成控件的吧
    比如
    if s = 'TEdit' then
    //动态生成EDIT控件就可以了啊
      

  2.   

    with FindClass('TEdit') do
    begin
      Create(self);
      Parent := self ;
      Top  := nTop ;
      Left := nLeft ;
      ...
    end;
      

  3.   

    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个要求。
      

  4.   

    实际应用中,一个窗体几乎肯定会有事件处理函数,所以我们要达成第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;interfaceuses
    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;
      

  5.   

    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.