VCL消息处理机制
说到VCL中的消息处理就不能不提到TApplication，Windows会为每一个当前运行的程序建立一个消息队列，用来完成用户与程序的交互，正是通过Application完成了对Windows消息的集中处理！
首先通过Application.Run进入消息循环进行消息的处理，其中调用了HandleMessage。
procedure TApplication.HandleMessage; var Msg: TMsg; begin
//这里先调用ProcessMessage处理，返回值为False调用Idle，就是在空闲时，即消息队列中无消息等待处理时调用Idle if not ProcessMessage(Msg) then Idle(Msg); end; function TApplication.ProcessMessage(var Msg: TMsg): Boolean; var Handled: Boolean; begin Result := False; if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then//查询消息队列中有无消息等待处理，参数PM_REMOVE使消息在处理完后会被删除。 begin Result := True; if Msg.Message <> WM_QUIT then//如果是WM_QUIT,终止进程，否则执行下面的代码 begin Handled := False; if Assigned(FOnMessage) then FOnMessage(Msg, Handled); if not IsHintMsg(Msg) and not Handled and not IsMDIMsg(Msg) and not IsKeyMsg(Msg) and not IsDlgMsg(Msg) then begin TranslateMessage(Msg);//将记录Msg传递给Windows进行转换 DispatchMessage(Msg); //将记录Msg回传给Windows end; end else FTerminate := True; end; end;
然后程序中的各个VCL对象又是如何接收到Windows消息的呢？这还要从窗体的创建开始！
首先找到TWinControl.CreateWnd中的
Windows.RegisterClass(WindowClass) //调用RegisterClass注册一个窗体类
向上看
WindowClass.lpfnWndProc := @InitWndProc; //这里指定了窗口的消息处理函数的指针为@InitWndProc！
再找到function InitWndProc(HWindow: HWnd; Message, WParam, LParam: Longint): Longint;
发现了
CreationControl.FHandle := HWindow;
SetWindowLong(HWindow, GWL_WNDPROC,Longint(CreationControl.FObjectInstance));
没有？
原来InitWndProc初次被调用时候，又使用API函数SetWindowLong指定处理消息的窗口过程为FObjectInstance。
回到TWinControl.Create
FObjectInstance := Classes.MakeObjectInstance(MainWndProc);
找到关键所在了，也许有些朋友对MakeObjectInstance这个函数很熟了，它的作用就是将一个成员过程转换为标准过程。
绕了个圈子？为什么呢？很简单，因为窗体成员过程包括一隐含参数传递Self指针，所以需要转化为标准过程。
const
//这个不难理解吧？314*13+10=4092，再大的话，记录TInstanceBlock的大小就超过了下面定义的PageSize InstanceCount = 313; type PObjectInstance = ^TObjectInstance; TObjectInstance = packed record Code: Byte; Offset: Integer; case Integer of 0: (Next: PObjectInstance); 1: (Method: TWndMethod); end; type PInstanceBlock = ^TInstanceBlock; TInstanceBlock = packed record Next: PInstanceBlock; Code: array[1..2] of Byte; WndProcPtr: Pointer; Instances: array[0..InstanceCount] of TObjectInstance; end; var InstBlockList: PInstanceBlock; InstFreeList: PObjectInstance; function StdWndProc(Window: HWND; Message, WParam: Longint; LParam: Longint): Longint; stdcall; assembler; asm XOR EAX,EAX PUSH EAX PUSH LParam PUSH WParam PUSH Message MOV EDX,ESP //将堆栈中构造的记录TMessage指针传递给EDX MOV EAX,[ECX].Longint[4] //传递Self指针给EAX，类中的Self指针也就是指向VMT入口地址 CALL [ECX].Pointer //调用MainWndProc方法 ADD ESP,12 POP EAX end; function CalcJmpOffset(Src, Dest: Pointer): Longint; begin Result := Longint(Dest) - (Longint(Src) + 5); end; function MakeObjectInstance(Method: TWndMethod): Pointer; const BlockCode: array[1..2] of Byte = ( $59, { POP ECX } $E9); { JMP StdWndProc } PageSize = 4096; var Block: PInstanceBlock; Instance: PObjectInstance; begin if InstFreeList = nil then begin Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);//分配虚拟内存，并指定这块内存为可读写并可执行 Block^.Next := InstBlockList; Move(BlockCode, Block^.Code, SizeOf(BlockCode)); Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdWndProc)); Instance := @Block^.Instances; repeat Instance^.Code := $E8; { CALL NEAR PTR Offset } Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code); Instance^.Next := InstFreeList; InstFreeList := Instance; Inc(Longint(Instance), SizeOf(TObjectInstance)); until Longint(Instance) - Longint(Block) >= SizeOf(TInstanceBlock); InstBlockList := Block; end; Result := InstFreeList; Instance := InstFreeList; InstFreeList := Instance^.Next; Instance^.Method := Method; end;
（注：上面出现的那些16进制代码其实就是些16进制的机器代码 $59=Pop ECX $E8=Call $E9=Jmp）
以上代码看起来有点乱，但综合起来看也很好理解！MakeObjectInstance实际上就是构建了一个Block链表
其结构看看记录TInstanceBlock的结构可知其结构如下：
Next //下一页指针
Code //Pop ECX和Jmp
WndProcPtr //和StdWndProc间的地址偏移
Instances //接下来是314个Instance链表
Instance链表通过记录TObjectInstance也很好理解其内容
Code //Call
Offset //地址偏移
Method //指向对象方法的指针（结合TMethod很好理解TWndMethod这类对象方法指针指向数据的结构）
好现在来把这个流程回顾一遍，Windows回调的是什么呢？其实是转到并执行一段动态生成的代码：先是执行Call offset ，根据偏移量转去执行Pop ECX，当然由于在Call这之前会将下一条指令入栈，所以这里弹出的就是指向对象方法的指针。接下来就是执行jmp [StdWndProc]，其中将堆栈中构造的记录TMessage指针赋给了EDX，而根据上面的解释结合TMethod去理解，很容易理解
MOV EAX,[ECX].Longint[4] ;传递Self指针给EAX，类中的Self指针也就是指向VMT入口地址
CALL [ECX].Pointer ;调用MainWndProc方法
现在终于豁然开朗了，Windows消息就是这样被传递到了TWinControl.MainWndProc，相比MFC中的回调全局函数AfxWndProc来根据窗体句柄检索对应的对象指针的方法效率要高的多！VCL比MFC优秀的又一佐证！ ^_^
现在终于找到了VCL接收消息的方法MainWndProc
procedure TWinControl.MainWndProc(var Message: TMessage); begin try try
//由于TControl创建实例时已经将FWindowProc指向WndProc，所以这里实际也就是调用WndProc
WindowProc(Message);
finally
FreeDeviceContexts;
FreeMemoryContexts;//调用FreeDeviceContexts和FreeMemoryContexts是为了保证VCL线程安全
end;
except
Application.HandleException(Self);
end;
end;
这里也不能忽略了TWinControl.WndProc
procedure TControl.WndProc(var Message: TMessage); var Form: TCustomForm; KeyState: TKeyboardState; WheelMsg: TCMMouseWheel; begin ... //省略以上的消息相关处理代码，研究某些特定消息时可自行查看 ... Dispatch(Message);//调用Dispatch处理 end;
接下来，先不急着查看Dispatch中的相应代码。想想看，忘了什么？
上面只是继承于TWinControl的有句柄的控件，那继承于TGraphicControl的没有句柄的控件是如何获得并处理消息的？下面以鼠标消息为例：
TWinControl.WndProc中有下面的代码：
case Message.Msg of ... WM_MOUSEFIRST..WM_MOUSELAST: //注1：下面再解释这段 if IsControlMouseMsg(TWMMouse(Message)) then begin { Check HandleAllocated because IsControlMouseMsg might have freed the window if user code executed something like Parent := nil. } if (Message.Result = 0) and HandleAllocated then DefWindowProc(Handle, Message.Msg, Message.wParam, Message.lParam); Exit; end; ... end; inherited WndProc(Message); //执行祖先类的WndProc方法 function TWinControl.IsControlMouseMsg(var Message: TWMMouse): Boolean; var Control: TControl; P: TPoint; begin if GetCapture = Handle then begin Control := nil; if (CaptureControl <> nil) and (CaptureControl.Parent = Self) then Control := CaptureControl; end else Control := ControlAtPos(SmallPointToPoint(Message.Pos), False);//这里通过ControlAtPos获得了鼠标所在控件 Result := False; if Control <> nil then begin P.X := Message.XPos - Control.Left; P.Y := Message.YPos - Control.Top; Message.Result := Control.Perform(Message.Msg, Message.Keys, Longint(PointToSmallPoint(P)));//调用Perform方法发送消息给对应的实例 Result := True; end; end; property WindowProc: TWndMethod read FWindowProc write FWindowProc; function TControl.Perform(Msg: Cardinal; WParam, LParam: Longint): Longint; var Message: TMessage; begin Message.Msg := Msg; Message.WParam := WParam; Message.LParam := LParam; Message.Result := 0; if Self <> nil then WindowProc(Message);//由于TControl创建实例时已经将FWindowProc指向WndProc，所以这里实际也就是调用WndProc Result := Message.Result; end;
VCL中就是这样将消息分发给了那些继承于TGraphicControl的没有句柄的图形控件。
上面说的都是Windows消息（Windows Messages），似乎还应该说说两条经常用到的VCL中自定义消息：CM_MOUSEENTER，CM_MOUSELEAVE（CM = Short of Control Message）
它们是如何被处理的呢？还是看上面的（if not ProcessMessage(Msg) then Idle(Msg);），这两条不是Windows消息，所以会触发Idle
procedure TApplication.Idle(const Msg: TMsg); var Control: TControl; Done: Boolean; begin Control := DoMouseIdle;//调用DoMouseIdle方法 ... end; function TApplication.DoMouseIdle: TControl; var CaptureControl: TControl; P: TPoint; begin GetCursorPos(P); Result := FindDragTarget(P, True);//获取当前鼠标所停留在的控件 if (Result <> nil) and (csDesigning in Result.ComponentState) then Result := nil; CaptureControl := GetCaptureControl; if FMouseControl <> Result then//判断以前记录的鼠标指针所指向的控件和现在所指向的控件是否相同 begin if ((FMouseControl <> nil) and (CaptureControl = nil)) or ((CaptureControl <> nil) and (FMouseControl = CaptureControl)) then FMouseControl.Perform(CM_MOUSELEAVE, 0, 0);//发送消息CM_MOUSELEAVE给以前记录的鼠标指针所指向的控件 FMouseControl := Result;//记录当前鼠标指针所指向的控件 if ((FMouseControl <> nil) and (CaptureControl = nil)) or ((CaptureControl <> nil) and (FMouseControl = CaptureControl)) then FMouseControl.Perform(CM_MOUSEENTER, 0, 0);//发送消息CM_MOUSEENTER给鼠标指针现在所在的控件 end; end; function FindDragTarget(const Pos: TPoint; AllowDisabled: Boolean): TControl; var Window: TWinControl; Control: TControl; begin Result := nil; Window := FindVCLWindow(Pos);//这里返回的是TWinControl，是一个有句柄的控件 if Window <> nil then begin Result := Window;
//鼠标所指向处可能还存在一继承于TGraphicControl的图形控件，而上面返回的只是其容器控件
Control := Window.ControlAtPos(Window.ScreenToClient(Pos), AllowDisabled);
if Control <> nil then Result := Control;//如果存在就返回用ControlAtPos所得到的控件
end;
end;
于是又转到了上面的TControl.Perform
现在所有的问题又都集中到了Dispatch的身上，消息是如何触发事件的处理方法的呢？
首先看条消息处理方法的申明：
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
这实际可以认为是申明了一个动态方法，调用Dispatch实际上就是通过消息号在DMT（动态方法表）中找到相应的动态方法指针，然后执行
//上面已经提到了，寄存器EAX中是类的Self指针，即VMT入口地址，寄存器EDX中是指向记录Message的指针
procedure TObject.Dispatch(var Message);
asm
PUSH ESI
MOV SI,[EDX] //消息号，也就是记录TMessage中Msg的值，对应CM_MOUSEENTER就是$B013(45075)
OR SI,SI
JE @@default
CMP SI,0C000H
JAE @@default
PUSH EAX
MOV EAX,[EAX] //VMT入口地址
CALL GetDynaMethod //调用GetDynaMethod查找
POP EAX
JE @@default //在GetDynaMethod中如果找到会将标志位寄存器的值置为0，如果是1，表示未找到，执行跳转
MOV ECX,ESI //传递指针给ECX
POP ESI
JMP ECX //跳转到ECX所指向的位置，也就完成了通过消息号调用CMMouseEnter的过程
@@default:
POP ESI
MOV ECX,[EAX]
JMP dword ptr [ECX].vmtDefaultHandler //如果此控件和它的祖先类中都没有对应此消息号的处理方法,调用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 //交换EAX和ESI的值，这之后ESI中为VMT入口地址，EAX为消息号，即对应动态方法的代号
JMP @@haveVMT
@@outerLoop:
MOV ESI,[ESI]
@@haveVMT:
MOV EDI,[ESI].vmtDynamicTable //尝试着将DMT的入口地址传递给EDI
TEST EDI,EDI //通过EDI是否为0来判断是否存在DMT
JE @@parent //不存在跳转到父类继续
MOVZX ECX,word ptr [EDI] //取[EDI]，即DMT的头两个字节的值传递给ECX，即动态方法的个数
PUSH ECX
ADD EDI,2 //地址加2,即跳过DMT中存储动态方法的个数的部分
REPNE SCASW //EAX与EDI指向的数据按字依次比较，直到找到（ZF=1）或ECX=0为止
JE @@found
POP ECX
@@parent:
MOV ESI,[ESI].vmtParent //尝试获得父类
TEST ESI,ESI //通过EDI是否为0来判断是否存在父类
JNE @@outerLoop //存在就跳转到@@outerLoop进行查找
JMP @@exit //退出
@@found:
POP EAX
ADD EAX,EAX
SUB EAX,ECX { this will always clear the Z-flag ! } ;这句的用途就上上面说到的将标志位ZF置0
MOV ESI,[EDI+EAX*2-4] //将获得的方法指针传递给ESI，理解这句先要对DMT结构的内容做些了解
@@exit:
POP EDI
end;
在VCL中，DMT的结构是这样的，前2个字节储存了DMT中动态方法的个数n，然后是方法代号，共4*n字节，最后是方法指针，也是4*n字节！
这样就很好理解了，EDI-4就是当前方法代号所在地址，EDI-4+4*n=EDI+EAX*2-4（因为已经执行了一句ADD EAX,EAX，所以EAX=2*n）所以，[EDI+EAX*2-4]就是所找到了相应方法指针。
结合下面的
TNotifyEvent = procedure(Sender: TObject) of object; FOnMouseEnter: TNotifyEvent; property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter; procedure TXXX.CMMouseEnter(var Message: TMessage); begin inherited; if Assigned(FOnMouseEnter) then FOnMouseEnter(Self); end;
在跳转到CMMouseEnter执行后，判断方法指针FOnMouseEnter是否是nil，如果不为空，就执行相应的事件处理方法！
通过以上的一个看似复杂的过程，我们这些用Delphi的开发人员只需要很简单的在类似
procedure TFormX.XXXMouseEnter(Sender: TObject);
begin
//
end;
(XXX.OnMouseEnter:=XXXMouseEnter;)
的过程中写两行简单的代码，就能很容易的实现所谓的事件驱动！