VCL中消息處理初探

2019-11-18 18:46:57

字體：大中小

來源：轉載

供稿：網友

TObject是基類，所以我們先看一下TObject的DISPATCH方法。Dispatch根據傳入的message來尋找相應的消息處理方法，如果找不到的話，就繼續向上到父類的消息處理方法表中尋找響應的處理方法，一直到找到為止，如果找到頂還沒有，則調用DefaultHandle來處理該消息。message可以是任何的類型，Dispatch假設message的頭兩位是消息的ID，它就是根據ID來尋找消息處理方法的。雖然任何類型的message都可以被接受，但是TObject的子類還是希望傳入的message參數是TMessage的記錄類型或其他證明的記錄類型。
以下聲明和注釋摘自與system.pas:
{ TObject.Dispatch accepts any data type as its Message parameter. The
first 2 bytes of the data are taken as the message id to search for
in the object's message methods. TDispatchMessage is an example of
such a structure with a Word field for the message id.
}
TDispatchMessage = record
    MsgID: Word;
end;
類的繼承關系如下：
TObject->TPersistent->TComponent->TControl
TControl是所以可視化組件的父類，TControl提供了一個新的方法，WndPRoc:
procedure TControl.WndProc(var Message: TMessage);
var
Form: TCustomForm;
KeyState: TKeyboardState;
WheelMsg: TCMMouseWheel;
begin
//如果處在設計期
if (csDesigning in ComponentState) then
begin
    Form := GetParentForm(Self);//得到擁有該組件的窗體
    if (Form <> nil) and (Form.Designer <> nil) and
      Form.Designer.IsDesignMsg(Self, Message) then Exit //消息由窗體來處理
end;

//窗體可以為其擁有的組件來處理鍵盤消息。
if (Message.Msg >= WM_KEYFIRST) and (Message.Msg <= WM_KEYLAST) then
begin
Form := GetParentForm(Self);
if (Form <> nil) and Form.WantChildKey(Self, Message) then Exit;
end

//關于鼠標的消息
else if (Message.Msg >= WM_MOUSEFIRST) and (Message.Msg <= WM_MOUSELAST) then
begin
     //如果組件不可以接受和處理雙擊消息，就將雙擊消息映射為單擊消息。
    if not (csDoubleClicks in ControlStyle) then
      case Message.Msg of
        WM_LBUTTONDBLCLK, WM_RBUTTONDBLCLK, WM_MBUTTONDBLCLK:
          Dec(Message.Msg, WM_LBUTTONDBLCLK - WM_LBUTTONDOWN);
      end;

    case Message.Msg of
      WM_MOUSEMOVE: application.HintMouseMessage(Self, Message);//如果是鼠標移動的消息，則出現hint窗口
      WM_LBUTTONDOWN, WM_LBUTTONDBLCLK://如果是左鍵被按下，或者雙擊，如果是自動拖動模式，則開始拖動，并將左鍵按下的狀態加入組件的狀態。
        begin
          if FDragMode = dmAutomatic then
          begin
            BeginAutoDrag;
            Exit;
          end;
          Include(FControlState, csLButtonDown);
        end;
      WM_LBUTTONUP:
        Exclude(FControlState, csLButtonDown); //如果是左鍵放開，則將左鍵按下的狀態剔除。
    else
      with Mouse do
        if WheelPresent and (RegWheelMessage <> 0) and //如果鼠標有滾輪，并且滾輪滑動時發出了消息
          (Message.Msg = RegWheelMessage) then
        begin
          GetKeyboardState(KeyState); //將256虛擬鍵的狀態拷貝到緩存中去
          with WheelMsg do //填充記錄
          begin
            Msg := Message.Msg;
            ShiftState := KeyboardStateToShiftState(KeyState);
            WheelDelta := Message.WParam;
            Pos := TSmallPoint(Message.LParam);
          end;
          MouseWheelHandler(TMessage(WheelMsg)); //派發鼠標滾輪的消息
          Exit;
        end;
    end;
end
else if Message.Msg = CM_VISIBLECHANGED then
    with Message do
      SendDockNotification(Msg, WParam, LParam); //處理自定義消息
Dispatch(Message); //派發未處理的消息
end;
但是只有TWinControl可以獲得焦點：
procedure TWinControl.WndProc(var Message: TMessage);
var
Form: TCustomForm;
begin
case Message.Msg of
    WM_SETFOCUS: //設置控件的焦點
      begin
        Form := GetParentForm(Self);
        if (Form <> nil) and not Form.SetFocusedControl(Self) then Exit;
      end;
    WM_KILLFOCUS:
      if csFocusing in ControlState then Exit;
//當鼠標有活動的時候發出該消息，如果鼠標沒有被捕捉到，則消息發往鼠標下面的那個窗口，否則消息將發往捕捉到鼠標的那個窗口。
    WM_NCHITTEST:
      begin
        inherited WndProc(Message); //調用父類的處理方法
       //如果窗體被擋住并且在指定的點沒有控件，則返回結果為在client區。
        if (Message.Result = HTTRANSPARENT) and (ControlAtPos(ScreenToClient(
          SmallPointToPoint(TWMNCHitTest(Message).Pos)), False) <> nil) then
          Message.Result := HTCLIENT;
        Exit;
      end;
    WM_MOUSEFIRST..WM_MOUSELAST:
      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;
    WM_KEYFIRST..WM_KEYLAST:
      if Dragging then Exit;
    WM_CANCELMODE:
      if (GetCapture = Handle) and (CaptureControl <> nil) and
        (CaptureControl.Parent = Self) then
        CaptureControl.Perform(WM_CANCELMODE, 0, 0);
end;
inherited WndProc(Message);
end;

TApplication在程序中發揮著重要的作用：
Application.Run;

procedure TApplication.Run;
begin
FRunning := True;
try
    AddExitProc(DoneApplication);
    if FMainForm <> nil then
    begin
      case CmdShow of
        SW_SHOWMINNOACTIVE: FMainForm.FWindowState := wsMinimized;
        SW_SHOWMAXIMIZED: MainForm.WindowState := wsMaximized;
      end;
      if FShowMainForm then
        if FMainForm.FWindowState = wsMinimized then
          Minimize else
          FMainForm.Visible := True;

    //一個消息循環直到Terminated為True時才退出。
      repeat
        try
          HandleMessage;
        except
          HandleException(Self);
        end;
      until Terminated;
    end;
finally
    FRunning := False;
end;
end;

procedure TApplication.HandleMessage;
var
Msg: TMsg;
begin
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 //從現成的消息循環中取出消息并放入指定的消息結構中。
begin
    Result := True;
    if Msg.Message <> WM_QUIT then //如果不是退出消息則進行相應的處理
    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);
        DispatchMessage(Msg);
      end;
    end
    else
      FTerminate := True;
end;
end;