您现在的位置:首页 >> VCL >> VCL >> 内容

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

时间:2011-9-3 16:27:16 点击:

  核心提示:说到VCL的优秀就不能不提到其对Windows消息及API的较全面和完美的封装,正因为如此开发者在大多数情况下甚至不需理会Windows消息处理的细节,而只需要写几行事件驱动代码即可!但如果做为开发人...
说到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;

作者:网络 来源:转载
共有评论 0相关评论
发表我的评论
  • 大名:
  • 内容:
本类推荐
  • 没有
本类固顶
  • 没有
  • 盒子文章(www.2ccc.com) © 2017 版权所有 All Rights Reserved.
  • 沪ICP备05001939号