delphi的消息处理机制TWinControl.WndProc

原创 2012年03月21日 18:27:38

delphi在处理消息的时候是逐级调用的,最基础的算是 TWinControl.WndProc函数了,下面给出了这个函数的源代码。

procedure TWinControl.WndProc(var Message: TMessage);
var
  Form: TCustomForm;
  LMouseEvent: TTrackMouseEvent;
  P: TPoint;
  Target: TControl;
begin
  case Message.Msg of
    CM_UNTHEMECONTROL:
      if (csDesigning in ComponentState) and ThemeServices.ThemesAvailable then
      begin
        SetWindowTheme(Handle, ' ', ' ');
        SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_FRAMECHANGED);
      end;
    CM_SETACTIVECONTROL:
      begin
        Form := GetParentForm(Self);
        if (Form <> nil) and (Form <> Self) then
          Form.Perform(CM_SETACTIVECONTROL, Message.WParam, Message.LParam);
      end;
    WM_SETFOCUS:
      begin
        Form := GetParentForm(Self);
        if (Form <> nil) and (not (csDesigning in Form.ComponentState) or (Form.Parent = nil)) then
          if not Form.SetFocusedControl(Self) then Exit;
      end;
    WM_KILLFOCUS:
      if csFocusing in ControlState then Exit;
    WM_NCHITTEST:
      begin
        inherited WndProc(Message);
        if (Message.Result = HTTRANSPARENT) and (ControlAtPos(ScreenToClient(
          SmallPointToPoint(TWMNCHitTest(Message).Pos)), False) <> nil) then
          Message.Result := HTCLIENT;
        Exit;
      end;
    WM_MOUSELEAVE:
      begin
        FMouseInClient := False;
        if FMouseControl <> nil then
          FMouseControl.Perform(CM_MOUSELEAVE, 0, 0)
        else
          Perform(CM_MOUSELEAVE, 0, 0);
        FMouseControl := nil;
      end;
    WM_MOUSEFIRST..WM_MOUSELAST:
      begin
        if Message.Msg = WM_MOUSEMOVE then
        begin
          P := ClientToScreen(Point(TWMMouse(Message).XPos, TWMMouse(Message).YPos));
          CaptureControl := GetCaptureControl;
          if CaptureControl = nil then
            Target := FindDragTarget(P, True)
          else
            Target := CaptureControl;
          if (FMouseControl <> Target) then
          begin
            if ((FMouseControl <> nil) and (CaptureControl = nil)) or
               ((CaptureControl <> nil) and (FMouseControl = CaptureControl)) or
               ((CaptureControl is TControl) and (CaptureControl.Parent = FMouseControl)) then
              FMouseControl.Perform(CM_MOUSELEAVE, 0, 0);
            if FMouseControl <> nil then
              FMouseControl.RemoveFreeNotification(Self);
            FMouseControl := Target;
            if FMouseControl <> nil then
              FMouseControl.FreeNotification(Self);
            if ((FMouseControl <> nil) and (CaptureControl = nil)) or
               ((CaptureControl <> nil) and (FMouseControl = CaptureControl)) then
              FMouseControl.Perform(CM_MOUSEENTER, 0, 0);
          end;
          if not FMouseInClient then
          begin
            FMouseInClient := True;
            // Register for a WM_MOUSELEAVE message which ensures CM_MOUSELEAVE
            // is called when the mouse leaves the TWinControl
            LMouseEvent.cbSize := SizeOf(LMouseEvent);
            LMouseEvent.dwFlags := TME_LEAVE;
            LMouseEvent.hwndTrack := Handle;
            LMouseEvent.dwHoverTime := HOVER_DEFAULT;
            _TrackMouseEvent(@LMouseEvent);
          end;
        end;
        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;
    WM_MOUSEACTIVATE:
      if IsControlActivateMsg(TWMMouseActivate(Message)) then
      begin
        if (Message.Result = 0) and HandleAllocated then
          inherited WndProc(Message);
        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);
    CM_DESTROYHANDLE:
      begin
        if Boolean(Message.WParam) then // Sender has csRecreating set
          UpdateRecreatingFlag(True);
        try
          DestroyHandle;
        finally
          if Boolean(Message.WParam) then
            UpdateRecreatingFlag(False);
        end;
        Exit;
      end;
  end;
  inherited WndProc(Message);

  if Message.Msg = WM_UPDATEUISTATE then
    Invalidate; // Ensure control is repainted
end;

这里面有很多消息。欢迎大家讨论分享。



版权声明:本文为博主原创文章,未经博主允许不得转载。

相关文章推荐

delphi中Message消息的使用方法

实例1 unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, For...

Delphi 自定义消息处理过程与Windows消息处理过程

Delphi中,自定义消息处理过程与Windows消息处理过程的定义是一样的。 1.主用步骤: 1>. 首先定义一个消息标识符常量;如:WM_MYMessage = WM_USER+ 5;(标识符...

delphi中Message消息的使用方法

原文:http://blog.csdn.net/delphi1234/article/details/2110083 实例1 unit Unit1;interfaceuses Win...

窗体,控件消息拦截

       #region  form 窗体消息拦截        const int WM_RBUTTONDOWN = 0x0204;     //右键单击       const int WM_...
  • jieon
  • jieon
  • 2010年10月28日 01:15
  • 940

delphi完美经典--第九、十章

第9章 Delphi用户接口设计详述 TObject->TPersistent->TComponent->TControl->大部分VCL组件(例外的如Ttimer父类为TComponent) D...
  • mwj_88
  • mwj_88
  • 2013年07月04日 11:15
  • 4131

定时执行Oracle作业任务

创建一个数据表,并创建一个过程,使一分钟运行该过程一次。 1)创建表。 SQL> create table test (mydate date); Table created. (2)创建一个...

delphi xe连接oracle心得(备忘)纯原创,一个字一个字打的

前几天朋友要求我给他的程序增加一个功能,数据库是oracle 11g的,因为以前没用过oracle,所以配置开发环境费了很大的劲,现在记录下来,怕以后忘记 1、服务器安装了windows serve...
  • jfdnnew
  • jfdnnew
  • 2016年10月23日 19:36
  • 1167

消息处理函数LRESULT CALLBACK WndProc 和应用程序主函数int WINAPI WinMain

 Windows程序是事件驱动的,对于一个窗口,它的大部分例行维护是由系统维护的。每个窗口都有一个消息处理函数。在消息处理函数中,对传入的消息进行处理。系统内还有它自己的缺省消息处理函数。  ...

消息处理函数LRESULT CALLBACK WndProc()、应用程序主函数int WINAPI WinMain ()

一、消息处理函数 LRESULT CALLBACK WndProc();//二、应用程序主函数int WINAPI WinMain ()Windows程序是事件驱动的,对于一个窗口,它的大部分例行维护...
  • ohmygol
  • ohmygol
  • 2011年01月13日 16:41
  • 6765

DELPHI中的消息处理机制

====================================================== 注:本文源代码点此下载 =============================...
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:delphi的消息处理机制TWinControl.WndProc
举报原因:
原因补充:

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