分享
 
 
 

VCL源码分析方法论

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

最近一段时间似乎流行源码分析:)我也来谈谈在过去一段时间里对VCL源码的分析方法方面的一点体会,本文将不探讨VCL类库的构架和设计模式方面的东本,只是以我们常见的控件属性/方法的实现过程作简单的说明,希望对初学者有所帮助

VCL分析方法

例:TButton.Caption属性的由来

(本文仅以此献给DELPHI初学者)

用过一段时间DELPHI的朋友,都会对VCL源码感兴趣。本人也常常在各大论坛见到一些网友研究讨论过关于VCL源码的贴子。不过,很多网友很努力的想看懂,可最后还是半途而废,因为他们总是理不出个头绪、看得云里雾里。笔者我也有看源码的习惯,没事的时候就点点鼠标右键,总是希望得到一些侥幸的收获和开发技巧。

不过万事都得先有个基本前题,就像人上学的过程一样(这里指正常人)要按部就班的来,一般不可能小学一毕业就直接去念大学,除非他(她)是个天才或经过特别培训。所以各位GGJJDDMM,看VCL源码也是有个基本前题的,首先你得熟悉WIN32 API/SDK,如果你说不知道的话,可以参考书籍《Programming Windows》(中文名《WINDOWS 程序设计》)。其次是你应当对Object Pascal比较熟悉,或者你曾经对DELPHI的组件进行过扩展(做过组件开发),那么我相信你对Object Pascal已经熟悉。不熟也不要紧,DELPHI的在线帮助就有对Object Pascal的讲述,如果英文太差也不要紧,网上也有很多热心网友翻译过来的中文帮助和语言参考书。

呵呵,本人写技术文章就像在写散文:)

言归正传,我们这篇文章的主题是对VCL源码的分析,分析当然有一个分析方法的问题,总不能随便打开一个源程序,逮着一个函数就分析一个函数吧:)所以我们也应该有选择,有目的的分析。

想想我们每天编码时都会遇到的属性有哪些?呵呵,NAME,CAPTION,VISIBLE,还有一些控件的TEXT(如EDIT1.TEXT)。那么我们就以控件的CAPTION来分析吧。

当然不是每个控件都有CAPTION属性的,我们这里就用TButton类的Caption属性进行分析。

打开每天我们都会使用的DELPHI,在FORM窗体上放一个按钮,得到一个Button1的按钮控件,按F12打天源程序,有没有找到这段代码呢:

Button1: TButton;

对了,在TButton上点击鼠标右键,在弹出的上下文菜单中选择第一项Find Declaration,找到TButton类的定义,如下所示:

TButton = class(TButtonControl)

private

FDefault: Boolean;

FCancel: Boolean;

FActive: Boolean;

FModalResult: TModalResult;

procedure SetDefault(Value: Boolean);

。。。。。。

原来TButton继承于TButtonControl类,呵呵:)

在左边的对象窗口(Exploring Unit.pas窗口)中找到TButton的CAPTION属性,如下图:

双击CAPTION属性,找到定义CAPTION属性的源码,大家可能发现什么都没有,只有一个

property Caption;

呵呵,写过组件的朋友都知道,按理Caption属性应该有读/写文本的方法啊?在哪里去了呢,呵呵,这里没有出现,当然应该在它的父类里了(这里只是申明Caption出来的地方),我们顺着刚才的方法继续在TButtonControl,发现也没有,最终我们在TControl类里找到了这个CAPTION,至于为什么是protected成员,我就不多说了:

protected

procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic;

procedure AdjustSize; dynamic;

procedure AssignTo(Dest: TPersistent); override;

procedure BeginAutoDrag; dynamic;

function CanResize(var NewWidth, NewHeight: Integer): Boolean; virtual;

function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; virtual;

procedure Changed;

procedure ChangeScale(M, D: Integer); dynamic;

。。。。。。

property Caption: TCaption read GetText write SetText stored IsCaptionStored;

看看GetText、SetText就是操作文本属性的函数了,我们找到GetText、SetText定义如下:

function GetText: TCaption;

procedure SetText(const Value: TCaption);

还有TCaption,它的定义居然是一个自定义类型:

TCaption = type string;

说明GetText返回值和SetText的调用参数本来也就是一个string型的:)

下面我们来看看GetText源码:

function TControl.GetText: TCaption;

var

Len: Integer;

begin

Len := GetTextLen;//得到文本长度

SetString(Result, PChar(nil), Len);// 设置Result返回以Len指定的长度

if Len <> 0 then GetTextBuf(Pointer(Result), Len + 1);//长度不为空,Result得到文本数据

end;

如果不明白GetTextBuf的用法,看看如下的代码:

procedure TForm1.Button1Click(Sender: TObject);

var

Buffer: PChar;

Size: Byte;

begin

Size := Edit1.GetTextLen; //得到EDIT1的文本长

Inc(Size);

GetMem(Buffer, Size); //创建EDIT1文本长度大小的缓存空间

Edit1.GetTextBuf(Buffer,Size); //由缓存得到文本,Buffer里的值就是Edit1.Text

Edit2.Text := StrPas(Buffer); //Buffer转换为PASCAL字符类型数据

FreeMem(Buffer, Size); //释放内存

end;

以上程序的行为同以下程序相当:

procedure TForm1.Button1Click(Sender: TObject);

begin

Edit2.Text := Edit1.Text;

end;

回到GetText函数,其中GetTextLen的作用是得到文本长度,GetTextBuf得到文本数据。

SetText就更简单了,定义如下:

procedure TControl.SetText(const Value: TCaption);

begin

if GetText <> Value then SetTextBuf(PChar(Value));

end;

意思是如果设定的Value与原来的不同,则重新设置缓存文本。

为了更深入VCL底部,我们再看看GetTextLen如何实现的(其实SetTextBuf和GetTextLen的实现过程相似):

function TControl.GetTextLen: Integer;

begin

Result := Perform(WM_GETTEXTLENGTH, 0, 0);//WM_派发的是WINDOWS标准消息

end;

看到这里想必大家都明白了,如果还不明白(没用过Perform),我看再看看Perform,它到底做了什么:

function TControl.Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;

var

Message: TMessage;

Begin

{你的消息赋予TMessage }

Message.Msg := Msg; ;

Message.WParam := WParam;

Message.LParam := LParam;

Message.Result := 0;//0表示返回不处理

if Self <> nil then WindowProc(Message);//不为空,将消息交给TControl的窗口过程WindowProc处理

Result := Message.Result;//返回结果

end;

这里主要再看看WindowProc做了什么,TControl里面WindowProc是这样定义的:

property WindowProc: TWndMethod read FWindowProc write FWindowProc;

在TControl的Create函数中:

constructor TControl.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FWindowProc := WndProc;

。。。。。。

可见我们还要找到TControl 的WndProc过程才能明白究竟,

WndProc过程定义如下:

procedure WndProc(var Message: TMessage); override;

实现:

procedure TControl.WndProc(var Message: TMessage);

var

Form: TCustomForm;

KeyState: TKeyboardState;

WheelMsg: TCMMouseWheel;

begin

if (csDesigning in ComponentState) then

begin

Form := GetParentForm(Self);

if (Form <> nil) and (Form.Designer <> nil) and

Form.Designer.IsDesignMsg(Self, Message) then Exit

end;

if (Message.Msg >= WM_KEYFIRST) and (Message.Msg <= WM_KEYLAST) then

begin

Form := GetParentForm(Self);

if (Form <> nil) and Form.WantChildKey(Self, Message) then Exit;

end

else if (Message.Msg >= WM_MOUSEFIRST) and (Message.Msg <= WM_MOUSELAST) then

begin

if not (csDoubleClicks in ControlStyle) then

case Message.Msg of

WM_LBUTTONDBLCLK, WM_RBUTTONDBLCLK, WM_MBUTTONDBLCLK:

Dec(Message.Msg, WM_LBUTTONDBLCLK - WM_LBUTTONDOWN);

end;

case Message.Msg of

WM_MOUSEMOVE: Application.HintMouseMessage(Self, Message);

WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:

begin

if FDragMode = dmAutomatic then

begin

BeginAutoDrag;

Exit;

end;

Include(FControlState, csLButtonDown);

end;

WM_LBUTTONUP:

Exclude(FControlState, csLButtonDown);

else

with Mouse do

if WheelPresent and (RegWheelMessage <> 0) and

(Message.Msg = RegWheelMessage) then

begin

GetKeyboardState(KeyState);

with WheelMsg do

begin

Msg := Message.Msg;

ShiftState := KeyboardStateToShiftState(KeyState);

WheelDelta := Message.WParam;

Pos := TSmallPoint(Message.LParam);

end;

MouseWheelHandler(TMessage(WheelMsg));

Exit;

end;

end;

end

else if Message.Msg = CM_VISIBLECHANGED then

with Message do

SendDockNotification(Msg, WParam, LParam);

Dispatch(Message);//派发消息

end;

这里主要讲讲Dispatch方法,它根据传入的消息调用消息的句柄方法,如果在组件类和它的父类都没有找到消息的处理句柄,Dispatch方法便会调用Defaulthandler(默认的消息处理方法),如下:

procedure TObject.Dispatch(var Message);

asm

PUSH ESI

MOV SI,[EDX]

OR SI,SI

JE @@default

CMP SI,0C000H

JAE @@default

PUSH EAX

MOV EAX,[EAX]

CALL GetDynaMethod

POP EAX

JE @@default

MOV ECX,ESI

POP ESI

JMP ECX

@@default:

POP ESI

MOV ECX,[EAX]

JMP DWORD PTR [ECX] + VMTOFFSET TObject.DefaultHandler//调用默认的消息处理方法

end;

而默认的消息处理如下,在SYSTEM.PAS单元里:

procedure TObject.DefaultHandler(var Message);

begin

end;

由以上代码看好像是没有任何处理过程,跟踪Object.DefaultHandler的汇编执行动作call dword ptr[ecx-$10],即调用Object.DefaultHandle,看看做何处理:

{Object.DefaultHandle}

Ret

Lea eax,[eax+$00]

即一个返回处理!

从最表面的Button.caption,我们走到了编译器层,可见所有东西都能找到它固有的原点!以caption的分析为基础,我们可以继续分析name属性和其它一些方法/函数。

希望我这篇‘散文’能给大家理出点头绪:)

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
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- 王朝網路 版權所有