分享
 
 
 

分析DFM文件生成程序界面

王朝delphi·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

近回答了一个问题,是关于根据DFM文件来生成程序的界面的,花了数天的研究,对于一般的程序界面

基本可以还原了。不敢自留,在这里将代码贴出来,里面没有多少解释,可能阅读不大方便,在这里表示

抱歉,本人没有多少时间,所以就请各位有兴趣地自己分析代码了。

其主要思路是用递归的方式来分析DFM文件,再用流化技术将类生成出来。以下是代码:

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

下面这个单元是注册组件类的,还可以增加,有兴趣者可以自己加上去。

unit UClass;

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..57] 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;

ClassArr[49] := TBitBtn;

CLassArr[50] := TShape;

ClassArr[51] :=TRadioGroup;

ClassArr[52] :=TImage;

ClassArr[53] :=TMediaPlayer;

ClassArr[54] :=TPaintBox;

ClassArr[55] :=TSpeedButton;

ClassArr[56] :=TMainMenu;

ClassArr[57] := TMenuItem;

RegisterClasses(ClassArr);

end;

initialization

RegClass;

finalization

UnRegisterClasses(ClassArr);

end.

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////

下面这个就是程序的单元了,不多说了。

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, ComCtrls, Contnrs,UClass;

type

TForm1 = class(TForm)

OpenDialog1: TOpenDialog;

Panel1: TPanel;

Panel2: TPanel;

Button1: TButton;

Button2: TButton;

Memo1: TMemo;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

{ Private declarations }

CurP:integer; //DFM文件的当前行

SS:TStrings; //保存DFM文件的文本格式

TS:TStrings; //保存DFM文件中的一个类的文本格式

L:TList; //管理DFM文件的所有类

public

{ Public declarations }

procedure GetControl(P:TWinControl); //根据分析DFM文件来生成组件类,其中有递归

procedure CorrectTS(TS:TStrings); //将组件的一些属性去掉,这些属性无法由流化技术来生成

function StrtoCom(TS:TStrings):TComponent; //根据组件类文本生成组件

function CheckEvent:boolean; //检查是否事件属性

function isControl(com:TComponent):boolean; //检查是否从TCotrol继承下来的

procedure TestShow(TS:TStrings);//在Memo1中显示所有的类文本

procedure delProp(TS:TStrings; bChar,eChar:char); //消掉一些特定的属性,为CorrectTS调用

published

end;

var

Form1: TForm1;

implementation

uses TypInfo;

{$R *.dfm}

//字符串转化为组件

function TForm1.StrToCom(TS: Tstrings): TComponent;

var

StrStream: TStringStream;

MemStream: TMemoryStream;

begin

StrStream := TStringStream.Create(TS.Text);

try

MemStream := TMemoryStream.Create();

try

Classes.ObjectTextToBinary(StrStream, MemStream);

MemStream.Seek(0, soFromBeginning);

Result := MemStream.ReadComponent(nil);

finally

FreeAndNil(MemStream);

end;

finally

FreeAndNil(StrStream);

end;

end;

//打开DFM文件,并显示在Memo1中,DFM文件有可能是二进制格式,

//也有可能是文本格式,所以这里要进行判断,并最终以文本格式打开

procedure TForm1.Button1Click(Sender: TObject);

var m:TmemoryStream; S:TStringStream;

F:array[1..6] of Char; temps:string;

begin

if OpenDialog1.Execute then

begin

S := TStringStream.Create('');

M := TMemoryStream.Create();

try

M.LoadFromFile(Opendialog1.FileName);

M.Position:=0;

M.Read(F,6);

temps:=F;

if temps='object' then//如果是文本格式

begin

M.Position:=0;

S.Position:=0;

S.CopyFrom(M,0);

end

else begin//如果是二进制格式

M.Position:=16;

Classes.ObjectBinaryToText(M,S);

end;

S.Position:=0;

SS.Text:=S.DataString;

Memo1.Lines:=ss;

finally

S.Free;

M.Free;

end;

end;

end;

//分析DFM文件,并生成组件类

procedure TForm1.Button2Click(Sender: TObject);

begin

if L.Count>0 then TComponent(L.Items[0]).free;

L.Clear;

Curp:=0;

GetControl(nil);//这里用到了递归

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

SS:=TStringList.Create;

TS:=TStringList.Create;

L:=TList.Create;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

FreeAndNil(SS);

if L.Count>0 then TComponent(L.Items[0]).free;

FreeAndNil(L);

FreeAndNil(TS);

end;

//生成组件

procedure TForm1.GetControl(P: TWinControl);

var Con:TComponent;

begin

while Curp<SS.Count-1 do

begin

if (pos('end',SS[curp])>0) then

begin inc(curp); break; end;

TS.Clear;

TS.Add(SS[Curp]);

inc(Curp);

while (Curp<SS.Count-1) do

begin

if (Pos('end',SS[curp])>0) or(pos('object',SS[curp])>0) then break;

if not CheckEvent then

TS.Add(SS[curp]);

inc(curp);

end;

TS.Add('end');

CorrectTS(TS);

Con:=StrtoCom(TS);

TestShow(TS);

if isControl(Con) then

TControl(Con).Parent:=P;

L.Add(Con);

if con.ClassName='TForm' then TForm(con).Show;

if (Pos('object',SS[curp])>0) then

GetControl(TWincontrol(Con)); //递归

if (Curp<SS.Count-1) then

if (pos('end',SS[curp])>0) then inc(curp);

end;

end;

procedure TForm1.CorrectTS(TS: TStrings);

var cout,i:integer; temps:string;

begin

cout:=Pos('object',TS[0]);//如果是TForm的子类,将其换成TForm类

if cout=1 then

begin

i:=pos(':',TS[0]);

temps:=Copy(TS[0],1,i);

temps:=temps+' Tform';

TS[0]:=temps;

exit;

end;

delProp(TS,'(',')');//消掉TStrings属性

delProp(TS,'<','>');//消掉Items属性

end;

function TForm1.CheckEvent: boolean;

var tstr:string;

begin

result:=false;

tstr:=trim(SS[curp]);

if (tstr[1]='O') and (tstr[2]='n') then

result:=true;

end;

function TForm1.isControl(com:TComponent): boolean;

begin

result:=false;

if Com.InheritsFrom(TControl) then

result:=true;

end;

procedure TForm1.TestShow(TS: TStrings);

var i:integer;

begin

for i:=0 to TS.Count-1 do

Memo1.Lines.Add(TS.Strings[i]);

end;

procedure TForm1.delProp(TS: TStrings; bChar, eChar: char);

var i:integer; temps:string;

begin

i:=0;

while (i<TS.Count-1)do

begin

temps:=TS[i];

if temps[length(temps)]= bChar then

break;

inc(i);

end;

while(temps[length(temps)]<>eChar)and (i<TS.Count-1)do

TS.Delete(i);

if (i<TS.Count-1) then

TS.Delete(i);

end;

end.

//////////////////////////////////////////////////////////////////////////////////////////////////////

程序功能并不强大,但有很多可以增强的地方,因为我去掉了其中的一些属性,这些属性在流化中不能读出来,如果那位有兴趣,可以

根据RTTI来还原这些属性的值。

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有