VCL中消息处理初探

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->TControlTControl是所以可视化组件的父类，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;