由VCL中的代码理解VCL中的消息处理机制(Delphi对消息机的封装)

 说到VCL的优秀就不能不提到其对Windows消息及API的较全面和完美的封装，正因为如此开发者在大多数情况下甚至不需理会Windows消息处理的细节，而只需要写几行事件驱动代码即可！

但如果做为开发人员你还是想对此做些了解的话，那么就继续，通过VCL代码本身来体会VCL中的消息处理机制。

(以下代码取自Delphi 6)

说到VCL中的消息处理就不能不提到TApplication，Windows会为每一个当前运行的程序建立一个消息队列，用来完成用户与程序的交互，正是通过Application完成了对Windows消息的集中处理！

首先通过Application.Run进入消息循环进行消息的处理，其中调用了HandleMessage。

 

 

procedure TApplication.HandleMessage; var Msg: TMsg; begin if not ProcessMessage(Msg) then Idle(Msg);//这里先调用ProcessMessage处理，返回值为False调用Idle，就是在空闲时，即消息队列中无消息等待处理时调用Idle。 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 InstanceCount = 313;//这个不难理解吧？314*13+10=4092，再大的话，记录TInstanceBlock的大小就超过了下面定义的PageSize 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;