• Delphi对WM_NCHITTEST消息的处理


    前提:WM_NCHITTEST是很重要的,只要鼠标在活动,Windows无时无刻在发这个消息进行探测。

    --------------------------------------------------------------------------------

    TWinControl = class(TControl)
    private
      procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    end;
    
    procedure TWinControl.WMNCHitTest(var Message: TWMNCHitTest);
    begin
      with Message do
        if (csDesigning in ComponentState) and (FParent <> nil) then
          Result := HTCLIENT
        else
          inherited;
    end;
    
    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);
            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;

    虽然WndProc具有优先权,但是却刻意调用了inherited WndProc(Message);,因此会首先执行TWinControl.WMNCHitTest,如果发现是透明并且能找到一个TControl,那么就算击中了HTCLIENT
    --------------------------------------------------------------------------------

    THintWindow = class(TCustomControl)
    private
      procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    end;
    
    procedure THintWindow.WMNCHitTest(var Message: TWMNCHitTest);
    begin
      Message.Result := HTTRANSPARENT;
    end;

    --------------------------------------------------------------------------------

    TScrollBox = class(TScrollingWinControl)
    private
      procedure WMNCHitTest(var Message: TMessage); message WM_NCHITTEST;
    end;
    
    procedure TScrollBox.WMNCHitTest(var Message: TMessage);
    begin
      DefaultHandler(Message); // TScrollBox和TScrollingWinControl都没有覆盖DefaultHandler函数,因此它会调用TWinControl.DefaultHandler
    end;

    --------------------------------------------------------------------------------

    procedure TCustomForm.ClientWndProc(var Message: TMessage);
    
      procedure Default;
      begin
        with Message do
          Result := CallWindowProc(FDefClientProc, ClientHandle, Msg, wParam, lParam);
      end;
    
      function MaximizedChildren: Boolean;
      var
        I: Integer;
      begin
        for I := 0 to MDIChildCount - 1 do
          if MDIChildren[I].WindowState = wsMaximized then
          begin
            Result := True;
            Exit;
          end;
        Result := False;
      end;
    
    var
      DC: HDC;
      PS: TPaintStruct;
      R: TRect;
    begin
      with Message do
        case Msg of
          WM_NCHITTEST:
            begin
              Default;
              if Result = HTCLIENT then Result := HTTRANSPARENT;
            end;
          WM_ERASEBKGND:
            begin
              FillRect(TWMEraseBkGnd(Message).DC, ClientRect, Brush.Handle);
              { Erase the background at the location of an MDI client window }
              if (FormStyle = fsMDIForm) and (FClientHandle <> 0) then
              begin
                Windows.GetClientRect(FClientHandle, R);
                FillRect(TWMEraseBkGnd(Message).DC, R, Brush.Handle);
              end;
              Result := 1;
            end;
          $3F://!
            begin
              Default;
              if FFormStyle = fsMDIForm then
                ShowMDIClientEdge(FClientHandle, (MDIChildCount = 0) or
                  not MaximizedChildren);
            end;
          WM_PAINT:
            begin
              DC := TWMPaint(Message).DC;
              if DC = 0 then
                TWMPaint(Message).DC := BeginPaint(ClientHandle, PS);
              try
                if DC = 0 then
                begin
                  GetWindowRect(FClientHandle, R);
                  R.TopLeft := ScreenToClient(R.TopLeft);
                  MoveWindowOrg(TWMPaint(Message).DC, -R.Left, -R.Top);
                end;
                PaintHandler(TWMPaint(Message));
              finally
                if DC = 0 then
                  EndPaint(ClientHandle, PS);
              end;
            end;
        else
          Default;
        end;
    end;

    --------------------------------------------------------------------------------

    procedure TScreen.SetCursor(Value: TCursor);
    var
      P: TPoint;
      Handle: HWND;
      Code: Longint;
    begin
      if Value <> Cursor then
      begin
        FCursor := Value;
        if Value = crDefault then
        begin
          { Reset the cursor to the default by sending a WM_SETCURSOR to the
            window under the cursor }
          GetCursorPos(P);
          Handle := WindowFromPoint(P);
          if (Handle <> 0) and
            (GetWindowThreadProcessId(Handle, nil) = GetCurrentThreadId) then
          begin
            Code := SendMessage(Handle, WM_NCHITTEST, 0, LongInt(PointToSmallPoint(P)));
            SendMessage(Handle, WM_SETCURSOR, Handle, MakeLong(Code, WM_MOUSEMOVE));
            Exit;
          end;
        end;
        Windows.SetCursor(Cursors[Value]);
      end;
      Inc(FCursorCount);
    end;

    --------------------------------------------------------------------------------

    procedure TCustomCombo.ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
      ComboProc: Pointer);
    var
      Point: TPoint;
      Form: TCustomForm;
    begin
      try
        with Message do
        begin
          case 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:
              if csDesigning in ComponentState then
              begin
                Result := HTTRANSPARENT;
                Exit;
              end;
            CN_KEYDOWN, CN_CHAR, CN_SYSKEYDOWN, CN_SYSCHAR:
              begin
                WndProc(Message);
                Exit;
              end;
          end;
          Result := CallWindowProc(ComboProc, ComboWnd, Msg, WParam, LParam);
          if (Msg = WM_LBUTTONDBLCLK) and (csDoubleClicks in ControlStyle) then
            DblClick;
        end;
      except
        Application.HandleException(Self);
      end;
    end;

    --------------------------------------------------------------------------------

  • 相关阅读:
    五:DockerFile制作Docker镜像
    六:Docker生产案例
    集群基础知识及haproxy负载均衡
    nfs服务部署记录
    haproxy 1.8.X版本编译安装教程
    Centos7.4安装kvm虚拟机
    什么是Docker
    Python—操作redis
    Python—redis
    机器学习之梯度下降法
  • 原文地址:https://www.cnblogs.com/findumars/p/5341651.html
Copyright © 2020-2023  润新知