VCL消息處理機制

阿新 • • 發佈：2018-06-20

... keyboard 轉換 scree 都是 keys 方法表 arr size

說到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;)
的過程中寫兩行簡單的代碼，就能很容易的實現所謂的事件驅動！

VCL消息處理機制

... keyboard 轉換 scree 都是 keys 方法表 arr size 說到VCL中的消息處理就不能不提到TApplication，Windows會為每一個當前運行的程序建立一個消息隊列，用來完成用戶與程序的交互，正是通過Application完成了對Wind

VCL消息處理機制

VCL消息處理機制

Android---Handler消息處理機制

MFC消息處理機制

MFC宏消息處理機制的原理

Android 異步消息處理機制前篇(二)：深入理解Message消息池

Android異步消息處理機制掌握，從源碼了解常使用的Handler

Handler消息處理機制

走進windows編程的世界-----消息處理函數（4）

窗體的消息處理

Android筆記二十五.Android事件Handler消息傳遞機制

storm 消息確認機制及可靠性

Android 消息處理源代碼分析（2）

用戶連接和斷開的消息處理

基於Kafka的生產者消費者消息處理本地調試

MFC_消息處理

RabbitMQ - Publisher的消息確認機制

消息處理模擬點擊

Python-RabbitMQ消息分發機制

oc消息轉發機制本質

iOS runtime探究(二): 從runtime開始深入理解OC消息轉發機制

VCL消息處理機制

相關推薦