好奇一下。看来Object Pascal确实与Windows深入结合了。
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; const UM_Test = WM_USER + 100; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } procedure MyMessage(var Msg: TMessage); message UM_Test; end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin Perform(UM_Test, 0, 0); end; procedure TForm1.MyMessage(var Msg: TMessage); begin inherited; ShowMessage('Hello'); end; end.
在message处理中和其他不一样的是inherited不会因为没有在祖先中找到一样的函数或者方法而将inherited失效，他会传入缺省的消息处理.
这里调用TFORM1的祖先的消息处理，由于tform和tcustomform没有这个实现UM_Test函数，所以直接调用的是tcustomform的defaulthandle.（注意这个方法是对twincontrol的override）。
但是，如果本类重载了DefaultHandler函数，就会直接调用本类的DefaultHandler函数：
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; const UM_Test = WM_USER + 100; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } procedure MyMessage(var Msg: TMessage); message UM_Test; procedure DefaultHandler(var Message); override; end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin Perform(UM_Test, 0, 0); end; procedure TForm1.DefaultHandler(var Message); begin with TMessage(Message) do begin if Msg = UM_Test then ShowMessage('DefaultHandler'); end; inherited; end; procedure TForm1.MyMessage(var Msg: TMessage); begin inherited; ShowMessage('Hello'); end; end.
顺便再看看这样改写的效果：
procedure TForm1.DefaultHandler(var Message); begin with TMessage(Message) do begin if Msg = UM_Test then ShowMessage('DefaultHandler'); if Msg = WM_SETTEXT then ShowMessage('WM_SETTEXT'); end; inherited; end;
理论解释：
因为WndProc里面调用了Dispatch，而Dispatch实际上是尝试调用动态方法，在动态方法表中查找Index是指定的方法，如果一直找到TObject都找不到Index是这个的方法，就会调用DefaultHandler。
这里面有几个概念，动态方法表和虚方法表，不要混了。
动态方法实际上在Class中是个最大65536的函数数组。调用的时候会根据Index到这个数组中来调用。而消息方法实际就是动态方法，方法声明后面的Message实际上就是Index。
VCL之所以对消息处理效率比VC等高，就是因为这个动态方法表，实际调用的就是用消息做下标直接调用方法。最多就是找几层继承的父类。而比VC的遍历要快。
Inherited动态方法的时候就是到父类的动态方法表找Index等于本方法Index的方法。如果父类没有这个方法就再到父类的父类找。都找不到就调用DefaultHandler。
动态方法和虚方法相比优点是省内存，另外能对Message的处理比较方便。虚方法不能做到对消息的方便处理。
虚方法则比较费内存，每个派生类都要有一套虚方法表。但是被调用的时候比动态方法要快，不需要到父类去找。
理论解释2：
你恰恰理解反了,不是Inherited会调用Dispatch,而是Dispatch会调用动态方法.
消息的调用次序实际上是
WndProc->Dispatch->动态方法或者DefaultHandler方法.
TControl.WndProc的最后一句就是Dispatch.
然后Dispatch就找Index的动态方法调用.
如果找不到就调用到DefaultHandler.
如果找到,就调用动态方法.
如果动态方法里面调用了Inherited,那么实际上inherited是编译器处理的.如果在祖宗里面有对应index的方法,那么就直接编译成调用该方法.如果祖宗里面没有该index的方法编译成调用DefaultHandler（存疑）.
实际上这样处理效率比运行时处理要快.
Inherited必须由编译器处理的,因为Inherited有两种含义.动态方法和虚方法的实现机制不同必然要根据方法编译成不同的代码.
====================================================================
procedure TObject.Dispatch(var Message); asm PUSH ESI MOV SI,[EDX] //获取index OR SI,SI JE @@default //如果是0,到default,也就是调用DefaultHandler CMP SI,0C000H JAE @@default //如果不在合理范围内,到default,也就是调用DefaultHandler PUSH EAX MOV EAX,[EAX] CALL GetDynaMethod //获取动态方法 POP EAX JE @@default //如果GetDynaMethod返回的是nil,到default,也就是调用DefaultHandler MOV ECX,ESI POP ESI JMP ECX //跳转到动态方法 @@default: POP ESI MOV ECX,[EAX] JMP DWORD PTR [ECX] + VMTOFFSET TObject.DefaultHandler end; procedure GetDynaMethod; { function GetDynaMethod(vmt: TClass; selector: Smallint) : Pointer; } asm { -> EAX vmt of class } { SI dynamic method index } { <- ESI pointer to routine } { ZF = 0 if found } { trashes: EAX, ECX } PUSH EDI XCHG EAX,ESI JMP @@haveVMT @@outerLoop: MOV ESI,[ESI] @@haveVMT: MOV EDI,[ESI].vmtDynamicTable //根据vmt获取该类的动态方法表 TEST EDI,EDI JE @@parent MOVZX ECX,word ptr [EDI] PUSH ECX ADD EDI,2 REPNE SCASW JE @@found //跳到found POP ECX @@parent: MOV ESI,[ESI].vmtParent //为空,那么找父类的 TEST ESI,ESI //测试父类是否为空 JNE @@outerLoop //跳出循环 JMP @@exit //退出 @@found: POP EAX ADD EAX,EAX SUB EAX,ECX { this will always clear the Z-flag ! } MOV ESI,[EDI+EAX*2-4] @@exit: POP EDI end;
对应的pascal代码如下
procedure TObject.Dispatch(var Message); type //THandlerProc = procedure(Self: Pointer; var Message) { of object }; THandlerProc = procedure(var Message) of object; var MsgID: Word; Addr: Pointer; M: THandlerProc; begin MsgID := TDispatchMessage(Message).MsgID;//消息id,也就是动态方法表的索引 if (MsgID <> 0) and (MsgID < $C000) then begin Addr := GetDynaMethod(PPointer(Self)^, MsgID);//获取class的动态方法表 if Addr <> nil then//如果拿到了动态方法就调用 begin //THandlerProc(Addr)(Self, Message) TMethod(M).Data := Self; TMethod(M).Code := Addr; M(Message); end else Self.DefaultHandler(Message);//如果找不到动态方法则调用defaultHandler end else Self.DefaultHandler(Message);//如果index范围不在应该在的范围内也调用DefaultHandler end; function GetDynaMethod(vmt: TClass; selector: SmallInt): Pointer; type TDynaMethodTable = record Count: Word; Selectors: array[0..9999999] of SmallInt; {Addrs: array[0..0] of Pointer;} end; PDynaMethodTable = ^TDynaMethodTable; var dynaTab: PDynaMethodTable; Parent: Pointer; Addrs: PPointer; I: Cardinal; begin while True do begin dynaTab := PPointer(PByte(vmt) + vmtDynamicTable)^;//根据vmt获取该类的动态方法表 if dynaTab <> nil then begin for I := 0 to dynaTab.Count - 1 do if dynaTab.Selectors[I] = selector then begin Addrs := PPointer(PByte(@dynaTab.Selectors) + dynaTab.Count * SizeOf(dynaTab.Selectors[0])); Result := PPointer(PByte(Addrs) + I * SizeOf(Pointer))^; Exit;//能找到则退出 end; end; Parent := PPointer(PByte(vmt) + vmtParent)^;//找不到则找父类的 if Parent = nil then Break;//如果父类是nil,也就是tobject了,则退出 vmt := PPointer(Parent)^; end; Result := nil; end;