如何动态载入form文件？

[skynew2004]

我要编写一个程序，目的要打开由delphi编写的源文件，注只要重绘form窗口及其控件即可，不要事件，我初步分析了delphi的源文件，即*.dfm即可，主要用来进行界面要析。请大家帮帮我？一定给分。

[skynew2004]

还是不行，
TForm1.SetProperty;中
SetPropValue(TempControl, PropName, PropValue);行出错，
提示7~8次错误，说font.color、font.Font.Charset等不存在。

您可否将您的源程序发e_mail至
[e-mail]
[e-mail]
[e-mail]

谢谢！

[skynew2004]

to: linzhengqun(风。为菜鸟服务)

我这里不能上QQ，您能否要信给我？谢谢。

[WGYKING]

unit Unit1;

interface

uses
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;

implementation

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

[WGYKING]

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;

implementation

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

[WGYKING]

倒
写了一个晚上
差不多了
还有一些问题
自己再修改一下

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;
设置所有对象的属性

写的很乱
有很多问题
大家讨论一下
看看哪些地方非常不合理的
修改完了把代码帖上来吧
一起学习一下。。。

睡觉先
中午和晚上还有饭局，烦。。。

[jackie168]

up~~

[WGYKING]

脱离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运行！

[WGYKING]

大家再讨论一下其他的实现方式
我只是用了简单的代码来实现
一定有更好的方式来处理

[linzhengqun]

析服，精神可佳。

[skynew2004]

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

[linzhengqun]

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

[halfdream]

呵,佩服修罗



呵呵.看来楼主是用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;

[skynew2004]

to:修罗

程序收到，正在研究之中。谢谢。

[linzhengqun]

刚才又改了一下，稍稍增强了一些。
我已经发给你那个第一版的了，第二版正在增强当中，楼主想要我再发给你吧。

[WGYKING]

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

[WGYKING]

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

[skynew2004]

我今天会见我的导师，导师说这样做太难了，可能就此一项我也做不了，别说界面评估了，目前已经将我的题目改变了，因此我不再做这方面的研究了。谢谢各位，特别感谢修罗。

[linzhengqun]

楼主我也发一个给你吧，不过对于比较复杂的界面，会有一些问题，事实上修罗的也应该有这个问题。我试过了。

不过修罗似乎中文显示会有一些问题，不知是不是我机的问题，你找一个有中文界面的试试。

我的是另一种现实方式吧，你也研究一下吧。呵呵
：》》》》》

[Eastunfail]

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

[inforum]

收藏一下