最近一段时间似乎流行源码分析：）我也来谈谈在过去一段时间里对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与原来的不同，则重新设置缓存文本。
解决方案 »
- 怎么样用adoquery对表进行重新排列？。。。。。在线等
- 如何在3D Max7中设置视频采样大小呀.怎么默认的都是32位呀,这样的话D7自带的Animate就不能播放了,:(,帮顶有分
- 一个关于spcomm控件的使用问题！
- 如何知道数组里存不存在某个元素？
- 如何可以使image控件显示大容量图片速度快些？哪位大虾帮帮我？谢谢!
- tqrdbtext在字段为空时能够自动变成0，如何实现？
- 我做了一个ActiveX注册后在delphi属性页上无法显示自定义的属性是怎么回事？
- edit 的小问题：：：一个窗体里有15个edit和一个button，。。。。。。。
- 关于调用当前工程的路径的函数，请高手们指点，快来这里
- 谢谢大家哎，我的系统。。。
- 100元200MB空间，全国最便宜的网上家园！
- 100分请问如何自动添加一个MDI子窗口
为了更深入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;
由以上代码看好像是没有任何处理过程，其实如果再调试代码，从CPU调试窗口发现有汇编代码执行，可见默认的消息处理是由编译器内置处理的。
从最表面的Button.caption，我们走到了编译器层，可见所有东西都能找到它固有的原点！以caption的分析为基础，我们可以继续分析name属性和其它一些方法/函数。
希望我这篇‘散文’能给大家理出点头绪：）
CAO，死胖子，老子是你同学：）
希望看贴的朋友也积极的发表自己的观点！
学到了新知识！
Thanks！
希望继续发贴！
支持！支持！支持！支持！支持！
宠辱不惊，看庭前花开花落，去留无意；毁誉由人，望天上云卷云舒，聚散任风。
————————————————————————————————————
JMP DWORD PTR [ECX] + VMTOFFSET TObject.DefaultHandler//调用默认的消息处理方法
这句后，会强制转到最后一个重载过DefaultHandler的类，比如以下程序的执行过程
{Size := Edit1.GetTextLen; //得到EDIT1的文本长}
当执行TObject.DefaultHandler的时候，它会转到以下语句继续执行，但我觉得它是DELPHI编译器特殊处理的结果
procedure TCustomEdit.DefaultHandler(var Message);
begin
case TMessage(Message).Msg of
WM_SETFOCUS:
if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
not IsWindow(TWMSetFocus(Message).FocusedWnd) then
TWMSetFocus(Message).FocusedWnd := 0;
end;
inherited;——》再到它的父类执行DefaultHandler函数。
还是不对,不会执行TObject中的虚拟方法,直接执行子类中覆盖的成员
如果子类没有覆盖的消息呢？你认为程序会如何处理？！
procedure TObject.DefaultHandler(var Message);
begin
end;没有做任何处理了
我并不认为begin end;之间没有任何代码就代表编译器没有执行任何的工作，Delphi的编译器如果执行到TObject.Destroy语句，会调用TObject.BeforeDestruction和ClassDestroy，TObject.Destroy在system单元里的构造过程如下：
destructor TObject.Destroy;
begin
end;
sorry，没有功夫看
说点其他的感受：
我对Delphi将Dispath和Defaulthandler放入TObject感到有点疑惑。why?
在VC的MFC架构中的老祖宗CClass没有这些，只是在其子类中才有，而Delphi却放到的老祖先哪里！
这对其他的类比如很多用户自定义类型或者非windows平台即没有用又缺乏平台可移植性。
自定义的消息你是会加上自定义的消息处理过程的。
to ehom(？！)
我想你都是按正常、VCL能处理得了的进行跟踪，你有没有跟踪过VCL类库最终没有处理的消息进行跟踪？
在BC3中声明这个的函数的语法是：
virtual void Foo(...) = [XXX];
而现在在Object Pascal中则是：
procedue Foo(...); message XXX;而在Dispatch中的代码就是取出参数的前四字节，把它看成一个整数，用这个整数作为标识在这张表中搜索，如果搜索不到的话再调用DefaultHandle。而DefaultHandle则是一个虚函数，可以被override。在窗口类代码中，它被override并去调用DefWindowProc(或DefMDIChildPoc、或是被超类化的预定义控制的本来的消息函数等）。我觉得Dispatch本来不需要成为virtual的，之以要让它成为overridable可能是为了在BCB中使用。因为BCB中不再支持DDVT技术，在BCB中写消息函数时是用一组宏封装了对Dispatch的override和一个switch分支。当消息处理里面调用inherited的时候，并不会直接去调用DefaultHandler，而是会去调用最近基类中标识相同的函数（注意代码是在具有标识的动态函数中），如果追溯到TObject都没有找到，才会去调用DefaultHandler。大家可以试一下面的代码：type
TBase = class
private
procedure X(var A); message 11;
end; TDerived = class (TBase)
private
procedure Y(var B); message 11;
end;
{ TBase }procedure TBase.X(var A);
begin
ShowMessage('TBase.X');
end;{ TDerived }procedure TDerived.Y(var B);
begin
ShowMessage('TDerived.Y');
inherited;
end;procedure TForm1.Button1Click(Sender: TObject);
var
Obj: TDerived;
M: Integer;
begin
Obj := TDerived.Create;
M := 11;
Obj.Dispatch(M);
Obj.Free;
end;此外，我觉得cg1120用来反驳myling的例子并合理，因为Destroy是个destructor面DefaultHandler只是个pocedure，我们知道Delphi面对constructor和destuctor的调用都是在语言级进行特殊处理的，而普通成员则没有这一步。
procedure DefaultHandler(var Message);
end;procedure TTest.DefaultHandler(var Message);
begin
inherited DefaultHandler(Message);
end;var
Test:TTest;
I: Integer;
begin
Test := TTest.Create;
Test.DefaultHandler(I);
Test.Free;
end;设个断点试试吧,其实编译器只是忠实的编译了上面的代码,不存在"内置处理"
我的观点还是TObject.DefaultHandler绝对在编译器级有处理
procedure TObject.DefaultHandler(var Message);
begin
end;
procedure TObject.DefaultHandler(var Message);
begin
end;
中我们来到最后调试的汇编代码地址就是走到该处，至于做了些什么事，你问问CPU才知道！
The first 4-byte field of every object is a pointer to the virtual method table (VMT) of the class. There is exactly one VMT per class (not one per object); distinct class types, no matter how similar, never share a VMT. VMTs are built automatically by the compiler, and are never directly manipulated by a program. Pointers to VMTs, which are automatically stored by constructor methods in the objects they create, are also never directly manipulated by a program.The layout of a VMT is shown in the following table. At positive offsets, a VMT consists of a list of 32-bit method pointers梠ne per user-defined virtual method in the class type梚n order of declaration. Each slot contains the address of the corresponding virtual method抯 entry point. This layout is compatible with a C++ v-table and with COM. At negative offsets, a VMT contains a number of fields that are internal to Object Pascal抯 implementation. Applications should use the methods defined in TObject to query this information, since the layout is likely to change in future implementations of Object Pascal.Offset Type Description
-76 Pointer pointer to virtual method table (or nil)
-72 Pointer pointer to interface table (or nil)
-68 Pointer pointer to Automation information table (or nil)
-64 Pointer pointer to instance initialization table (or nil)
-60 Pointer pointer to type information table (or nil)
-56 Pointer pointer to field definition table (or nil)
-52 Pointer pointer to method definition table (or nil)
-48 Pointer pointer to dynamic method table (or nil)
-44 Pointer pointer to short string containing class name
-40 Cardinal instance size in bytes
-36 Pointer pointer to a pointer to ancestor class (or nil)
-32 Pointer pointer to entry point of SafecallException method (or nil)
-28 Pointer entry point of AfterConstruction method
-24 Pointer entry point of BeforeDestruction method
-20 Pointer entry point of Dispatch method
-16 Pointer entry point of DefaultHandler method
-12 Pointer entry point of NewInstance method
-8 Pointer entry point of FreeInstance method
-4 Pointer entry point of Destroy destructor
0 Pointer entry point of first user-defined virtual method
4 Pointer entry point of second user-defined virtual method
// procedure DefaultHandler(var Message);
end;procedure TTest.DefaultHandler(var Message);
begin
//inherited DefaultHandler(Message);
end;
如果都注释掉，同样会回到procedure TObject.DefaultHandler(var Message)
-16 Pointer entry point of DefaultHandler method
那一段，并不是
-16 Pointer entry point of DefaultHandler method (or nil)这就说明,DefaultHandler肯定应该有入口地址，执行编译器对默认消息的内置处理。
1.使用Perform进行发送；
2.在窗口默认WndProc过程中进行处理，如果没有对应处理器就使用Dispatch进行分发，否则直接处理；
3.使用Dispatch进行分发的目标是直接父类的DefaultHandler方法，并且在里面寻找相应处理过程，如果有则直接处理，无则继续到当前类的直接父类中进行处理查找...，最后一直到TObject.DefaultHandler（至于这个方法是否有内置处理不清楚，没有看过CPU窗口）。而且，另外一点个人认为既然是一个良好的类库，不应该出现对于系统消息在消息处理链中捕捉不到的情形....
mov eax,ebx
mov ecx,[eax]
call dword prt [ecx-$10]而且，我感觉楼主担心所谓的有的消息最后得不到处理好象没有多大意义，还是我原来的那句话，一个设计良好的类库在对Windows消息系统进行封装的时候不太可能把一个系统消息漏掉！
不明白你的意思，不管你覆不覆盖DefaultHandler，TTest都会执行
procedure DefaultHandler(var Message);
end;procedure TTest.DefaultHandler(var Message);
begin
//inherited DefaultHandler(Message);
//把上面这句注释掉
end;var
Test:TTest;
I: Integer;
begin
Test := TTest.Create;
Test.DefaultHandler(I);
Test.free;
end;inherited DefaultHandler(Message);//少了这句,就不可能会去继承祖先类的方法的执行
在TObject.DefaultHandler里并没有执行begin，但执行了end，即结束消息处理！
JMP DWORD PTR [ECX] + VMTOFFSET TObject.DefaultHandler//调用默认的消息处理方法
end;
而默认的消息处理如下，在SYSTEM.PAS单元里：
procedure TObject.DefaultHandler(var Message);
begin
end;
由以上代码看好像是没有任何处理过程，其实如果再调试代码，从CPU调试窗口发现有汇编代码执行，可见默认的消息处理是由编译器内置处理的。
//*****************
我想這
/*-16 Pointer entry point of DefaultHandler method*/
是不是表示系統會對這個消息做些處理，隻是處理的工作量的問題而已（或者處理也隻是什麼也不做）。
TTest = class(TObject)
end;var
Test:TTest;
I: Integer;
begin
Test := TTest.Create;
Test.DefaultHandler(I);
Test.Free;
end;