如何动态载入form文件？

用记事本打开就可以了阿
放到memo里面

要重绘form窗口及其控件啊，与delphi中的一样显示出form,该如何做？

你都会分析delphi源文件，俺就是看不明，帮你顶

.dfm是窗体文件可以直接打开，不过我还不懂你说的什么意思

就是要打开窗体文件后再进行重新按窗体文件中设计的样式绘制出窗体，总之就像delphi打开源文件一样显示效果，不过不要事件、过程加载，只要窗体就行，有谁能帮帮我？

用pos把object全取出来。然后一个一个create
应该很简单把，left和top都有了。我觉得不是楼上的说的用途吧？那你也不会来这里问了，呵呵

不明白，有不处理MESSAGE的WINDOW吗？起码也要有个WM_PAINT or WM_SHOWWINDOW吧

明白！你会在delphi中动态的创建类吗？会的话就按照 gemouzhi(gemouzhi) 说法就可以了！不过也只能看看了。要修改请用delphi吧！要不我帮你写一个！

http://www.yixel.com/files/LexLib.rar
我以前做过的:P(8好意思,现在看当时写的代码,真的不怎么样,好多地方没有注释,而且代码也很混乱,也没时间重构了),里面有个Demo Serialize,你看看我是怎么实现的不过我的这个是把窗体的各种属性保存/读取在INI/XML中,你也可以自己扩充一下,实现自己的PropReader就可以让他支持DFM格式了.让他创建对象也可以参考一下这个,无非是自己手动创建对象并安排父子关系

我目前已经是按照 gemouzhi(gemouzhi)方法一个一个的取，不过太繁了，有的属性还不太好取，如color、Font.Name、Font.Style 、OldCreateOrder 等等、而且每个控件都要去写一段代码，太累了。有没有更好的方法？我已经写了一个form的代码，请大家看看有没有改进的地方。
procedure TForm1.ButtoClick(Sender: TObject);
var i:integer;
    filename1,str_,form_name:string;
    F1:textfile; s:variant;
   label next_readln;
begin
opendialog1.InitialDir:=getcurrentdir();
if opendialog1.Execute then
  begin
   filename1:=opendialog1.FileName;
   filename1:=myfun_dialog.getpathfilename(filename1)+'.pas';
   if not fileexists(filename1) then
     begin
           showmessage('打开'+filename1+'文件出错');
           exit;
     end;   assignfile(f1,filename1);    //先打开pas文件找出form的名称
   reset(f1);
   while not Eof(f1) do
     begin
        readln(f1,str_);     //读入
        str_:=del_null(str_);      //删除空格
        if  pos('=class(',lowercase(str_))>0    then  //找到form名 ///
         begin
            form_name:=leftstr(str_,pos('=',str_)-1);
            form_name:=rightstr(form_name,length(form_name)-2);
            showmessage(form_name);
            break;
         end;     end;
   closefile(f1);   filename1:=myfun_dialog.getpathfilename(filename1)+'.dfm';
   if not  fileexists(filename1) then
     begin
           showmessage('打开'+filename1+'文件出错');
           exit;
     end;
   showmessage(filename1);
   assignfile(f1,filename1);          //打开dfm文件开始显示
   reset(f1);
   while not Eof(f1) do
      begin
        readln(f1,str_);     //读入
        str_:=del_null(str_);      //删除空格        if pos('object',lowercase(str_))>0  then  //如果是dfm文件
          begin
          // showmessage('object'+form_name);
           if  pos('object'+lowercase(form_name),lowercase(str_))>0    then  //找到form区 ///
             begin
               with Tform.create(self) do
                  begin
                     while not Eof(f1) do
                        begin
                          readln(f1,str_);     //读入
                          str_:=del_null(str_);      //删除空格                          if pos('object',lowercase(str_))>0  then
                              begin
                                 show;
                                 break;   //form创建结束
                              end;                              if ((pos('left=',lowercase(str_))>0)and(pos('left=',lowercase(str_))=2)) then
                              begin
                                 left:=strtoint(rightstr(str_,length(str_)-pos('=',str_)));
                                 goto next_readln;
                              end;
                          if ((pos('top=',lowercase(str_))>0) and (pos('top=',lowercase(str_))=2)) then
                              begin
                                 top:=strtoint(rightstr(str_,length(str_)-pos('=',str_)));
                                 goto next_readln;
                              end;
                          if ((pos('width=',lowercase(str_))>0) and (pos('width=',lowercase(str_))=2)) then
                              begin
                                 width:=strtoint(rightstr(str_,length(str_)-pos('=',str_)));
                                 goto next_readln;
                              end;
                          if ((pos('height=',lowercase(str_))>0) and (pos('height=',lowercase(str_))=2)) then
                              begin
                                 height:=strtoint(rightstr(str_,length(str_)-pos('=',str_)));
                                 goto next_readln;
                              end;
                          if ((pos('caption=',lowercase(str_))>0)and(pos('caption=',lowercase(str_))=2)) then
                              begin
                                 caption:=rightstr(str_,length(str_)-pos('=',str_));
                                 goto next_readln;
                              end;
                          if ((pos('color=',lowercase(str_))>0)and(pos('color=',lowercase(str_))=2)) then
                              begin
                                 color:=Graphics.StringToColor(rightstr(str_,length(str_)-pos('=',str_)));
                                 goto next_readln;
                              end;
                          {if ((pos('font.charset=',lowercase(str_))>0)and(pos('font.charset=',lowercase(str_))=2))then
                              begin
                                 Font.Charset:=Graphics.StringToColor(rightstr(str_,length(str_)-pos('=',str_)));
                                 goto next_readln;
                              end;    }
                          if ((pos('font.color=',lowercase(str_))>0)and(pos('font.color=',lowercase(str_))=2))then
                              begin
                                 Font.Color:=Graphics.StringToColor(rightstr(str_,length(str_)-pos('=',str_)));
                                 goto next_readln;
                              end;
                          if ((pos('font.height=',lowercase(str_))>0)and(pos('font.height=',lowercase(str_))=2))then
                              begin
                                 Font.Height:=strtoint(rightstr(str_,length(str_)-pos('=',str_)));
                                 goto next_readln;
                              end;
                          if ((pos('font.name=',lowercase(str_))>0)and(pos('font.name=',lowercase(str_))=2))then
                              begin
                                 Font.Name:=midstr(str_,pos('=',str_)+2,length(str_)-pos('=',str_)-2);
                                 goto next_readln;
                              end;
                          caption:='被评估程序的窗口';
              next_readln:end;
            end;
           end;
        end;
     end;
     closefile(f1);
     end;
end;

你可以自己来创建对象(参考GetClass)并维护父子关系,然后使用我的LexLib里面的TPropInspector来动态修改属性.

procedure TForm1.Button2Click(Sender: TObject);
var
  aStream: TMemoryStream;
  bStream: TStringStream;
begin
  aStream := TMemoryStream.Create;
  bStream := TStringStream.Create('');  aStream.WriteComponent(Self);
  aStream.Position := 0;
  ObjectBinaryToText(aStream, bStream);
  ShowMessage(bStream.DataString);
  FreeAndNil(aStream);
  FreeAndNil(bStream);
end;

做类似的处理
改完了
再转换成二进制格式
因为D根本不认识文本方式的格式用修改后的文件初始化窗体实例：
aStream.ReadComponent(TempForm);
或根据它创建窗体实体：
TempForm := aStream.ReadComponent(nil);（好像是这样用^_^，也不知是否可以）

好像有点儿对。
能否再具体些？该句
TempForm := aStream.ReadComponent(nil);（好像是这样用^_^，也不知是否可以）
不对。
这些怎么写代码？做类似的处理
改完了
再转换成二进制格式
因为D根本不认识文本方式的格式能否发一个简单的实例？
[email protected]

TempForm := TempForm(aStream.ReadComponent(nil));//根据流内容创建
aStream.ReadComponent(TempForm);                 //根据流内容初始化
ObjectBinaryToText();                            //二进制格式转换成文本格式,可以明文修改
ObjectTextToBinary()                             //文本格式转换成二进制格式原理就这样
你看看VCL关于TPersistent、TComponent类的流化处理

能否发一个简单的例子，我的目的是要根据Opendialog打开的文件(delphi的源文件dfm),而后根据dfm文件中的内容重生成另一个form，该form中要原样显示出dfm中的所有控件与位置、大小、颜色。[email protected]

单纯的作dfm分析得话，如果抛弃了delphi本身的处理机制得话，个人觉得还是如小眼睛所说：不过我的这个是把窗体的各种属性保存/读取在INI/XML中,你也可以自己扩充一下,实现自己的PropReader就可以让他支持DFM格式了.让他创建对象也可以参考一下这个,无非是自己手动创建对象并安排父子关系
需要作的是一个转化类库。至于创建就简单多了。不知道小眼睛在LexLib都作了哪些。呵呵。

能否发一个简单的例子，我的目的是要根据Opendialog打开的文件(delphi的源文件dfm),而后根据dfm文件中的内容重生成另一个form，该form中要原样显示出dfm中的所有控件与位置、大小、颜色。[email protected]

看来有两种途径..
一种是按照VCL对象持久化机制还原窗体,就是修罗说的那样..
另一种是解析DFM,自己处理显示.楼主是准备走哪一条路呢?
fanhaili(小师妹)说的思路有可取之处的,不过做下去总会遇上一堆细节处理麻烦的.
两条路都会有一些处理上的大大小小的难题要克服的.
多花些功夫读读VCL源码.比如TStream.ReadComponent相关的..

skynew2004 ()
加我QQ，给你一个编程，应该有价值
68816088

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Contnrs, ExtCtrls;type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    TreeView1: TTreeView;
    Panel1: TPanel;
    Button5: TButton;
    Panel2: TPanel;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SetProperty;
  private
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  ControlList: TObjectList;implementationuses ClassUnit, TypInfo;{$R *.dfm}function CreateControlByName(ControlName, AClassName: String; AOwner: TWinControl = nil): TControl;
var
  Cls : TControlClass;
begin
  Result := nil;
  Cls := TControlClass(GetClass(AClassName));
  if Cls = nil then exit;
  Result := Cls.Create(AOwner);
  if (AOwner <> nil) and (Result.InheritsFrom(TWinControl)) then
    Result.Parent := AOwner;
  Result.Name := ControlName;
end;procedure TForm1.Button1Click(Sender: TObject);
var
  FileName: String;
  AStream: TMemoryStream;
  TextStream: TStringStream;
begin
  if OpenDialog1.Execute then
  begin
    FileName := OpenDialog1.FileName;    try
      AStream := TMemoryStream.Create;
      TextStream := TStringStream.Create('');      AStream.LoadFromFile(FileName);
      AStream.Position := 0;
      try
        ObjectBinaryToText(AStream, TextStream);
      except
        AStream.Position := 0;
        TextStream.CopyFrom(AStream, AStream.Size);
      end;
      Memo1.Text := TextStream.DataString;
    finally
      FreeAndNil(AStream);
      FreeAndNil(TextStream);
    end;
  end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  OpenDialog1.Filter := '窗体文件|*.DFM';  Button1.Anchors := [akLeft, akBottom];
  Button2.Anchors := Button1.Anchors;  ControlList := TObjectList.Create(True);
end;procedure TForm1.FormResize(Sender: TObject);
begin
  Memo1.Height := Self.Height - 100;
end;procedure TForm1.Button2Click(Sender: TObject);
var
  TempControl: TControl;  TempStr, NullStr: String;
  CurrNode: TTreeNode;
  I, J: Integer;
  ControlName, ClassType: String;
begin
  TreeView1.Items.Clear;
  ControlList.Clear;  for I := 0 to Memo1.Lines.Count - 1 do
    begin
      TempStr := Trim(Memo1.Lines[I]);
      if Pos('object', TempStr) > 0 then
        begin
          TempStr := Trim(Copy(TempStr, 8, Length(TempStr)));
          J := Pos(':', TempStr);
          ControlName := Copy(TempStr, 1, J - 1);
          ClassType := Copy(TempStr, J + 2, Length(TempStr));          NullStr := Memo1.Lines[I];
          J := Pos('object', NullStr);
          NullStr := Copy(NullStr, 1, J - 1);
          J := Length(NullStr) Div 2;
          if J = 0 then
            begin
              ClassType := 'TForm';
              CurrNode := TreeView1.Items.AddChild(nil, ControlName);
              TempControl := nil;
            end
          else
            begin
              if J > CurrNode.Level then
                CurrNode := TreeView1.Items.AddChild(CurrNode, ControlName)
              else
                if J = CurrNode.Level then
                  CurrNode := TreeView1.Items.AddChild(CurrNode.Parent, ControlName)
                else
                  if J < CurrNode.Level then
                    begin
                      CurrNode := CurrNode.Parent;
                      if CurrNode <> nil then
                        CurrNode := CurrNode.Parent;
                      CurrNode := TreeView1.Items.AddChild(CurrNode, ControlName);
                    end;              for J := 0 to ControlList.Count - 1 do
                begin
                  if TControl(ControlList[J]).Name = CurrNode.Parent.Text then
                    begin
                      TempControl := TControl(ControlList[J]);
                      Break;
                    end;
                end;
            end;
          TempControl := CreateControlByName(ControlName, ClassType, TWinControl(TempControl));
          ControlList.Add(TempControl);
          if ClassType = 'TForm' then
            TempControl.Show;
        end;
    end;
  SetProperty;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ControlList.Clear;
  ControlList.Free;
end;procedure TForm1.SetProperty;
var
  I, J, K, M: Integer;
  TempControl: TControl;
  TempNode: TTreeNode;
  TempStr, PropName, PropValue: String;Label
  NextControl;
begin
  for I := 0 to ControlList.Count - 1 do
  begin
    TempControl := TControl(ControlList[I]);
    for J := 0 to Memo1.Lines.Count - 1 do
      begin
        TempStr := Trim(Memo1.Lines[J]);
        if (TempStr = ('object ' + TempControl.Name + ': ' + TempControl.ClassName)) or (TempControl.ClassName = 'TForm') then
          begin
            for K := J + 1 to Memo1.Lines.Count - 1 do
              begin
                TempStr := Trim(Memo1.Lines[K]);
                if (Pos('object', TempStr) > 0) or (Pos('On', TempStr) > 0) or (TempStr = 'end') then GOTO NextControl;                M := Pos('=', TempStr);
                PropName := copy(TempStr, 1, M - 2);
                PropValue := Copy(TempStr, M + 2, Length(TempStr));
                try
                SetPropValue(TempControl, PropName, PropValue);
                except
                end;
              end;
          end;
      end;
    NextControl:
      ;
  end;
end;end.

unit ClassUnit;interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Contnrs,
  ActiveX,
  ActnList,
  ADODB,
  Buttons,
  Clipbrd,
  CommCtrl,
  ComObj,
  ComServ,
  DateUtils,
  DBCtrls,
  DBGrids,
  DBTables,
  ExtCtrls,
  Grids,
  IniFiles,
  Isapi,
  Isapi2,
  Mask,
  Math,
  Menus,
  Midas,
  MMSystem,
  MPlayer,
  msxml,
  OleDB,
  OpenGL,
  Printers,
  Registry,
  RichEdit,
  ScktComp,
  ShellAPI,
  ShlObj,
  SvcMgr,
  SyncObjs,
  UrlMon,
  WinInet,
  WinSock,
  WinSpool;procedure RegClass;
var
  ClassArr: Array[0..48] of TPersistentClass;implementationprocedure RegClass;
begin
  ClassArr[0] := TAnimate;
  ClassArr[1] := TButton;
  ClassArr[2] := TCheckBox;
  ClassArr[3] := TColorDialog;
  ClassArr[4] := TComboBox;
  ClassArr[5] := TComboBoxEx;
  ClassArr[6] := TCommonCalendar;
  ClassArr[7] := TCommonDialog;
  ClassArr[8] := TCoolBand;
  ClassArr[9] := TCoolBands;
  ClassArr[10] := TCoolBar;
  ClassArr[11] := TDateTimePicker;
  ClassArr[12] := TEdit;
  ClassArr[13] := TFindDialog;
  ClassArr[14] := TFontDialog;
  ClassArr[15] := TForm;
  ClassArr[16] := TFrame;
  ClassArr[17] := TGroupBox;
  ClassArr[18] := THeaderControl;
  ClassArr[19] := TImageList;
  ClassArr[20] := TLabel;
  ClassArr[21] := TListBox;
  ClassArr[22] := TListItem;
  ClassArr[23] := TListView;
  ClassArr[24] := TMemo;
  ClassArr[25] := TMonthCalendar;
  ClassArr[26] := TOpenDialog;
  ClassArr[27] := TPageControl;
  ClassArr[28] := TPageScroller;
  ClassArr[29] := TPrintDialog;
  ClassArr[30] := TProgressBar;
  ClassArr[31] := TRadioButton;
  ClassArr[32] := TReplaceDialog;
  ClassArr[33] := TRichEdit;
  ClassArr[34] := TSaveDialog;
  ClassArr[35] := TScrollBar;
  ClassArr[36] := TScrollBox;
  ClassArr[37] := TStaticText;
  ClassArr[38] := TStatusBar;
  ClassArr[39] := TStatusPanel;
  ClassArr[40] := TTabControl;
  ClassArr[41] := TTabSheet;
  ClassArr[42] := TToolBar;
  ClassArr[43] := TToolButton;
  ClassArr[44] := TTrackBar;
  ClassArr[45] := TTreeNode;
  ClassArr[46] := TTreeView;
  ClassArr[47] := TUpDown;
  ClassArr[48] := TPanel;
  RegisterClasses(ClassArr);
end;initialization
  RegClass;
finalization
  UnRegisterClasses(ClassArr);
end.

倒
写了一个晚上
差不多了
还有一些问题
自己再修改一下NOTE:载入窗体文件
不需要多说了吧^_^输出窗体
目前没有发现更好的办法，我现在是根据DFM文件内容模拟产生一个类似窗体 unit ClassUnit
主要用来注册类型，所以USES了很多单元，但是单元和类还差很多，自己再慢慢加入，呵呵。
不知是否有好的办法，得到所有类并注册它们，我这样做的确傻了一点unit Unit1
function CreateControlByName(ControlName, AClassName: String; AOwner: TWinControl = nil): TControl;
根据控件名、类名、容器来创建对象procedure TForm1.Button2Click(Sender: TObject);
分析DFM文件得出所有类及从属关系procedure TForm1.SetProperty;
设置所有对象的属性写的很乱
有很多问题
大家讨论一下
看看哪些地方非常不合理的
修改完了把代码帖上来吧
一起学习一下睡觉先
中午和晚上还有饭局，烦

WGYKING(修罗是谁？！) 辛苦了。
但我在还原您的程序时在单击button1后选择窗体文件后出现错误对话框。
停在ObjectBinaryToText(AStream, TextStream);语句上提示invaild stream format.
我知道在您的机器上是可以用的。
是否我的软件环境不同。
我是delphi6 + windows2000 server+sp4.

我以为Button1的单元事件，换成下面的代码：
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
Memo1.Lines.LoadFromFile(Opendialog1.FileName);
end;
试试如何

呵,佩服修罗呵呵.看来楼主是用objectBinarytoText去打开文本的DFM文件了....
DFM其实有两种格式,可能是二进制文件,也可能是TEXT格式....
在FORM上面右点击,TEXT DFM选项就是选择DFM保存的格式.修罗的程序这儿没有判断.//----------------------------------------------------------
const
  FilerSignature: array[1..4] of Char = 'TPF0';
procedure TReader.ReadSignature;
var
  Signature: Longint;
begin
  Read(Signature, SizeOf(Signature));
  if Signature <> Longint(FilerSignature) then ReadError(@SInvalidImage);
end;

还是不行，
TForm1.SetProperty;中
SetPropValue(TempControl, PropName, PropValue);行出错，
提示7~8次错误，说font.color、font.Font.Charset等不存在。您可否将您的源程序发e_mail至
[email protected]
[email protected]
[email protected]谢谢！

to: linzhengqun(风。为菜鸟服务) 我这里不能上QQ，您能否要信给我？谢谢。

脱离IDE运行；关于TXT或二进制DFM
我程序中没有判断
但是仍然做了处理
保证可以读出正确的数据格式；SetPropValue(TempControl, PropName, PropValue);
只是简单的设置属性
一般的类型它可以自动转换
你可以根据RTTI来判断类型
调用其他的函数来处理；if J < CurrNode.Level then
                    begin
                      CurrNode := CurrNode.Parent;
                      if CurrNode <> nil then
                        CurrNode := CurrNode.Parent;
                      CurrNode := TreeView1.Items.AddChild(CurrNode, ControlName);
                    end;
这段代码来分析从属关系
需要修改一下
当类层次很深的情况下可能要迭代处理
以得出正确的父子关系；
脱离IDE运行！

呵呵
我的代码只是实现了思路
有很多问题
抛砖引玉
是块砖头
[email protected]
^_^

中文的问题
DEDE一样会出项
我还不知怎么解决
事实上
这个代码帖上来后
一直没有修改过
呵呵

看我的leppy项目: http://leppy.sourceforge.net
好久没有更新了. 载入xml格式的描述文件,来根据此文件来生成界面和相关的程序逻辑 :) (半解释半编译型的),不过是 C#做的

调试易

如何动态载入form文件？

解决方案 »