VCL中消息处理初探

原创 2001年09月16日 18:49:00

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;

VCL中消息处理初探

TObject是基类,所以我们先看一下TObject的DISPATCH方法。Dispatch根据传入的message来寻找相应的消息处理方法,如果找不到的话,就继续向上到父类的消息处理方法表中寻找响应...
  • cdlff
  • cdlff
  • 2008年12月02日 09:07
  • 390

ShowModal在VCL和Firemonkey中的使用区别

通常在VCL中,要显示一个子窗口,使用下面的代码:      procedure TForm1.Button1Click(Sender: TObject);      var      ...
  • a00553344
  • a00553344
  • 2015年11月06日 11:17
  • 1186

VCL初探

VCL初探 Visual Component Library(可视化组件库)是一个设计完美的架构,作为一个很好的架构,VCL最大限度利用了继承,VCL架构的主体是由代表组件的类组成。其他的V...
  • zhanghai412
  • zhanghai412
  • 2012年10月03日 01:18
  • 365

关于VCL的编写 (一) 怎样编写自己的VCL控件

怎样编写自己的VCL控件       用过Delphi的朋友们,大概对Delphi的最喜欢Delphi的不是他的强类型的pascal语法,而是强大的VCL控件,本人就是一位VCL控件的爱好者。    ...
  • dreamnan
  • dreamnan
  • 2004年09月15日 13:07
  • 2235

Vcl控件详解

TTabControl 属性  DisplayRect:只定该控件客户区的一个矩形 HotTrack:设置当鼠标经过页标签时,它的字是否有变化。如果为True,是字会变成蓝色 Images:为...
  • qq_31834115
  • qq_31834115
  • 2016年08月18日 16:16
  • 357

《Inside VCL(深入核心——VCL架构剖析)》.(李维) 一

一、回到从前:1.1、多任务操作系统是如何设计和实现的? 1.1.1、系统——多个应用程序 方案1:(系统不断读取应用程序状态) 系统通过大型循环(Loop)不断坚持么一个恶用用程序是否触发了特定的事...
  • liang08114
  • liang08114
  • 2016年12月20日 21:03
  • 525

DevExpress VCL v16.1.3发布 两个API有重大变化

DevExpress VCL v16.1.3发布,本次更新有两个API(PDFViewer 和 RichEdit Control)有重大变化,请注意更新代码。...
  • IBigPig
  • IBigPig
  • 2016年08月16日 15:23
  • 1390

H.264分层结构:VCL、NAL

H.264的功能分两层 VCL (VideoCoding Layer,视频编码层):负责高效的视频内容表示。 NAL(NetworkAbstraction Layer,网络提取层):负责以网络所要求的...
  • ivy_reny
  • ivy_reny
  • 2015年07月30日 09:27
  • 947

MFC消息处理流程概述

Win32下的消息流程清晰明了,但在MFC下,由于封装的缘故,隐藏的有点深,对一般的开发人员而言,就不甚明了喽。本文试图粗略展示出MFC下消息处理的基本流程。 一、先看一下Win32下的消息处理流程...
  • wangyao1052
  • wangyao1052
  • 2012年10月07日 13:59
  • 8378

【重大更新】DevExpress v17.1新版亮点(VCL上篇)

想要开始使用我们的最新版?请下载免费的30天试用版——DevExpress VCL Controls v17.1,本站以连载的形式为大家介绍各版本新增内容。本文为大家介绍DevExpress VCL ...
  • AABBbaby
  • AABBbaby
  • 2017年07月07日 10:15
  • 1178
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:VCL中消息处理初探
举报原因:
原因补充:

(最多只允许输入30个字)