[原创] Delphi（一） --探索

======================================================
注：本文源代码点此下载
======================================================

注:以前在大富翁上的文章,希望一起整理到这里来。

{ no. 1 }

//创建模式窗体的句子

class procedure tmyform.runform(aobj1, aobj2: tobject);

var

vform: tmyform;

begin

vform := tmyform.create(application);

with vform do

try

initform(aobj1, aobj2);

showmodal;

finally

free;

end;

end;

(*说明:

通过class声明的函数,类似与vc中的静态函数;使用语句:tmyform.runform(vobj1, vobj2);

其他具体的,参考:delphi 帮助中的,class 类说明。

强调这个惯用法,就是为了:

1、如果此窗体在多处被使用,那么可以保证统一都调用此段代码;

2、如果功能上有所修改,比如:根据showmodal的返回值不同进行处理,那么只修改此函数就行了。

3、程序封装性好,易于维护和工作交接。

*)

{ no. 2 } tag 的使用

//窗体工具栏按钮事件的响应

procedure tmyform.runoperate(atag: integer);

begin

case atag of

1: mybutton.color := clred;

2: mybutton.color := clgreen;

3: mybutton.color := clblack;

end;

end;

procedure tmyform.toolbtnclick(sender: tobject);

begin

runoperate(tcontrol(sender).tag);

end;

//如果你在某下拉菜单中,也需要执行类似功能则

procedure tmyform.menuitemclick(sender: tobject);

begin

runoperate(tmenuitem(sender).tag);

end;

(*说明:

1、结构清晰

2、相关的信息集中,比较容易查错、修改和维护

3、提高程序的适应、扩展能力;比如现在要求不在工具栏按钮中实现,而要求在不同按钮中实现,则修改容易。

建议:每个分类后面只跟一行或不多的几行代码,如果代码比较多,使用过程函数替代。

比较有意思的是,我经常如下写:

case btnmybutton.visible of

{ 显示 } true: ...

{不显示} false: ...

end;

*)

{ no. 3 } 事件指针 做参数

//对于列表等的读取使用事件指针的方式

type

tdatasetevent = procedure (dataset: tdataset; aindex, acount: integer) of object;

//从 tadoquery派生而来的类

procedure tmyadoquery.enumrecord(awherestr: string; apro: tdatasetevent);

begin

close;

sql.clear;

sql.add('select * from table1');

if awherestr0 then exit;

end;

end;

但是,我们处理图形对象时,可能会直接调用 cads 的canperform公共函数即可

比如:http://www.delphibbs.com/keylife/iblog_show.asp?xid=824 中的

//*******方案二当需要的时候在创建属性窗体

uses

...

fproperty;

type

tfrmmymap = class

...

procedure onfrmmymapdestroy(sender: tobject);

procedure onmapgeoselected(ageo: tgeometry);

private

ffrmproperty: tfrmproperty;

procedure showpropertyform(avisible: boolean);

public

end;

procedure tfrmmymap.showpropertyform(avisible: boolean);

begin

if not assigned(ffrmproperty) then ffrmproperty := tfrmproperty.create(application);

ffrmproperty.visible := avisible;

end;

procedure tfrmmymap.onfrmmymapdestroy(sender: tobject);

begin

if assigned(ffrmproperty) then ffrmproperty.free;

end;

procedure tfrmmymap.onmapgeoselected(ageo: tgeometry);

begin

if assigned(ffrmproperty) then ffrmproperty.myrefresh(ageo);

end;

这里说明了:

1、需要时,动态创建你的对象 ffrmproperty

2、当前对象释放时,判断你的对象的合法性,然后释放动态创建的对象。

{ no. 15 }创建接口还是创建结构

//项目描述:我开发一个表格控件时,如果我将单元格设置为一个com,则如果表格现实的信息过多的话,则装载速度无法保证,甚至于有死机的可能。我之所以用com是为了将来每个单元格的处理和信息都可以在控件外扩展。

我的解决办法是:对于每个从cell派生来的控件创建一个实例,通过动态创建若干个结构对象record来记录个单元格的信息,如果需要对单元格进行操作,则将结构对象指针赋值给cell组件,测试结果很令人满意。

所以,如果需要使用某个com大量实例的话,尽量管理和维护一个实例,而对于其中的数据可以实行动态创建管理,速度上会有很好的效果。

另外,尽量声明一个 pmyinterface = ^imyinterface 借口指针,参数传递或使用时,直接使用接口指针,这样可以减少调用计数函数_addinft等,如果操作平凡也可以提高速度的。

{ no. 16 }

//对于记录类型record的分析。

实例:

type

tbaserec = record

rstr: integer;

rstr2: string;

rstr3: string;

end;

tstrrec = record

rstr: integer;

rstr2: string;

rstr3: string;

rstr4: string;

end;

procedure tform1.button3click(sender: tobject);

var

vrec1: tstrrec;

vbaserec: tbaserec;

begin

vrec1.rstr := 1;

vrec1.rstr2 := '123123';

vrec1.rstr3 := '1';

vrec1.rstr4 := '1';

vbaserec := tbaserec(pointer(@vrec1)^);

showmessage(inttostr(vbaserec.rstr) + '_' + vbaserec.rstr2 + '_' + vbaserec.rstr3);

//

end;

{说明:

1、记录类型互相转换时,必须保证基础record类型,数据大小sizeof应小于或等于扩展类型。保证转换后的记录类型对象的数据访问合法正确。

2、在delphi中,使用记录类型互相转换最为平凡的就是在消息record的实现上了。在delphi中定义了若干于tmessage可同时描述消息接受信息的record,如:

twmkey = packed record

msg: cardinal;

charcode: word;

unused: word;

keydata: longint;

result: longint;

end;

当需要接受keydown和keyup的消息时,我们即可以使用tmessage也可以使用twmkey作为消息接收的参数类型。因为delphi为我们提供了若干便利的消息类型,所以我们在使用消息处理问世时就不会象vc中那样繁琐和易错了。

3、记录类型的使用还提供了一个不同语言间数据信息封装访问的途径。在不同语言间使用记录类型和记录类型指针时,应注意内部定义的变量的类型匹配问题。

记录类型的本质测试研究:

更改上面例子的实现部分,测试:

procedure tform1.button3click(sender: tobject);

var

vrec1: tstrrec;

rstr: integer;

rstr2: string;

rstr3: string;

vpt: integer;

begin

vrec1.rstr := 1;

vrec1.rstr2 := '123123';

vrec1.rstr3 := '1';

vrec1.rstr4 := '1';

vpt := integer(@vrec1);

rstr := integer(pointer(vpt)^);

vpt := vpt + sizeof(rstr);

rstr2 := string(pointer(vpt)^);

vpt := vpt + sizeof(rstr2);

rstr3 := string(pointer(vpt)^);

showmessage(inttostr(rstr) + '_' + rstr2 + '_' + rstr3);

end;

提示信息于开始例子相同,则推测:

1、record类型中定义的数据是在一个连续空间中保存的

2、当定义函数时,如果考虑到函数处理的信息可能在后续版本中,需要扩充则可以使用记录变量的方式传递参数。当扩充函数时只需将记录变量根据此记录的版本号转换为对应的记录类型变量进行访问即可。具体实例可以参考windows api函数的版本升级及扩展情况。

}

{ no. 17 }事件类型属性,通过属性赋值函数操作

{在typinfo单元中,有若干函数可以让我们操作dephi管理的类的vmt。通过,属性名称和对象vtm直接访问或改变属性值。

公共的属性访问函数:getpropvalue;公共的属性设置函数:setpropvalue。其中,对事件属性信息的读取可以使用getpropvalue,但是却不能通过setpropvalue给事件属性赋值。

解决方案:使用setmethodprop给控件属性赋值。procedure setmethodprop(instance: tobject; const propname: string; const value: tmethod); overload;其中,tmethod 用以描述操作函数。

tmethod = record

code,//函数地址;可以通过类函数methodaddress,取得函数地址。其中,只有声明在published段的函数才能通过methodaddress访问。

data: pointer; //对象地址

end;

}

//**************** 正常使用

type

tmyform = class(tform)

...

private

fmytext: string;

published

procedure myclick(sender: tobject);

end;

//窗体中,按钮事件;实现动态分配另一个按钮的事件的方法

procedure tmyform.button1onclick(sender: tobject);

var

vmethod: tmethod;

begin

fmytext := 'hello joy!';

vmethod.code := self.methodaddress('myclick');//************ code 1

vmethod.data := self;//************ code 2

setmethodprop(button2, 'onclick', vmethod);

end;

procedure tmyform.myclick(sender: tobject);

begin

showmessage('ok!');//************ show 1

showmessage(self.fmytext);//************ show 2

end;

//**************** 修改 一

//将[code 1]和[code 2]处的self变更为tmyform。则[show 1]显示正常,[show 2]显示不正常。

//说明:当类的函数被执行时,寄存器eax保存的是当前类的地址。所以,tmethod.data中保存的应该是将来执行tmethod.code函数时,赋给eax的值,即类对象指针。

//又因为[show 1]中,不需要eax中类对象指针,所以可以正常执行。

//**************** 修改 二

//函数地址读取部分

procedure tmyform.button1onclick(sender: tobject);

var

vmethod: tmethod;

vevent: tnotifyevent;

begin

fmytext := 'hello joy!';

vevent := myclick;

vmethod.code := @vevent;//************ code 1

vmethod.data := self;//************ code 2

setmethodprop(button2, 'onclick', vmethod);

end;

//其中,myclick可以定义为私有函数。

//说明:vmethod只是要记录一个类的函数地址和类对象的地址。methodaddress函数也只是通过函数名称进行函数地址的读取而已。

{ no. 18 } 不通过汇编访问 [vmt]

vmt:virtual method table

//访问vmt信息

e.g.

procedure tform1.button1click(sender: tobject);

var

vpt: pointer;

vmethod: tmethod;

begin

vmethod.code := tform.methodaddress('myclick');

vmethod.data := self;

if vmethod.code = nil then showmessage('error!');

vpt := pointer(tlistbox);

integer(vpt) := integer(vpt) + vmttypeinfo; //在delphi帮助中说明,根据偏移量可以取得classinfo。或者可以参考,tobject.classinfo的定义。

setmethodprop(listbox2, getpropinfo(ptypeinfo(vpt^), 'onclick'), vmethod);

end;

//其中,类的类到底如何提取?

function tobject.classtype: tclass;

begin

mov eax, [eax]

end;

//上面的语句可以翻译成

function tobject.classtype: tclass;

begin

result := tclass(pointer(self)^);

end;

//所以上面的例子也可以改为

procedure tform1.button1click(sender: tobject);

var

vpt: pointer;

vmethod: tmethod;

begin

vmethod.code := tform.methodaddress('myclick');

vmethod.data := self;

if vmethod.code = nil then showmessage('error!');

vpt := pointer(pointer(listbox2)^);//取得classtype的指针

integer(vpt) := integer(vpt) + vmttypeinfo;

setmethodprop(listbox2, getpropinfo(ptypeinfo(vpt^), 'onclick'), vmethod);

end;

{仿照上面的例子,我们可以访问所有vmt入口地址,并取得相应的信息}

{ no. 19 } 使用汇编实现远程函数调用

//如何通过指针,调用类函数中定义的函数(如下面的:myfar)?

//如果我们只传递函数指针,然后调用函数的话,我们会发现,在myfar中不能访问当前类对象的变量fmytext。如果嵌入一段汇编,将当前位置压入栈,然后再调用此函数,则就可以象类函数一样,在其中访问类的变量了。

e.g.

type

pmyrec = ^tmyrec;

tmyrec = record

rstr: string;

rint: integer;

end;

procedure myproc(apro: pointer);

var

callerbp: cardinal;

myrec: tmyrec;

vpt: pointer;

begin

myrec.rstr := 'myrec.rstr';

myrec.rint := 'myrec.rint';

vpt := pointer(@myrec);

asm

mov eax, [ebp]

mov callerbp, eax

mov eax, vpt

push callerbp

end;

end;

procedure tmytemp.settext(atext: string);

procedure myfar(arec: tmyrec);

begin

showmessage(format('%s_%sd_%s', [self.fmytext, arec.rstr, arec.rint]);

end;

begin

self.fmytext := 'joyyuan';

myproc(addr(myfar));

end;

{说明:具体例子可以参考:grids单元中,tsparsepointerarray.forall的实现。

}

{ no. 20 }类函数地址

测试结果列举:也是测试方法和测试思维经历的过程。

结果一:button1.canfocus与button2.canfocus的地址相同

结果二:button1.canfocus与form1.canfocus的地址相同,也等同于listbox1.canfocus

结果三:当在tform1窗体类中,重载form1.canfocus后,button1.canfocus与form1.canfocus的地址不相同

结论:如果没有重载父类的虚函数,则访问时,直接得到并访问父类的函数。所以,tbutton, tlistbox, tform默认都访问的是twincontrol的canfocus。所以函数地址相同。

结果四:定义事件类型

type

tmyevent1 = function(): boolean of object;

tmyevent2 = function(): boolean;

得结果:sizeof(tmyevent1) = 8;sizeof(tmyeven2) = 4;

结论:类函数类型,保存的室两个指针的内容,见tmethod中,code 和 data;既一个函数指针,一个对象指针。

验证测试例子一:

var

vtestevent: tnotifyevent;

begin

pointer((@@vtestevent)^) := @tform1.myclick; //或者通过:tform1.methodaddress('myclick') 方式取函数地址

pointer(pointer(integer(@@vtestevent) + 4)^) := pointer(self);

vtestevent(nil); //效果和执行 self.myclick一样。

end;

验证测试例子二:

var

vmethod: tmethod;

begin

vmethod.code := tform1.methodaddress('myclick');

vmethod.data := self;

tnotifyevent(vmethod)(nil);//效果和执行 self.myclick一样。

end;

======================================================
在最后，我邀请大家参加新浪APP，就是新浪免费送大家的一个空间，支持PHP+MySql，免费二级域名，免费域名绑定 这个是我邀请的地址，您通过这个链接注册即为我的好友，并获赠云豆500个，价值5元哦！短网址是http://t.cn/SXOiLh我创建的小站每天访客已经达到2000+了，每天挂广告赚50+元哦，呵呵，饭钱不愁了，\(^o^)/