• 终于懂了:TWinControl.DefaultHandler里的CallWindowProc(FDefWndProc)还挺有深意的,TButton对WM_PAINT消息的处理就是靠它来处理的(以前不明白为什么总是要调用inherited,其实就是没有明白TWinControl.DefaultHandler的真正用处)


    我忽然发现:TButton既没有处理WM_PAINT,又没有Paint()或者PaintWindow(),那么它是什么时候被绘制的?

    Form1上放2个TButton,然后设置代码:

    procedure TForm1.Button1Click(Sender: TObject);
    begin
      button2.Repaint;
    end;
    
    procedure TForm1.Button2Click(Sender: TObject);
    begin
      ShowMessage('good');
    end;

    在Form1第一次显示时,应该会让这两个Button显示。这两个Button应该会处理WM_PAINT并显示。可是完全找不到相关代码啊。

    后来用脑子想了想,TButton是TWinControl,而且是没有图形子控件的,所以它收到WM_PAINT时应该会依次执行:

    procedure TButtonControl.WndProc(var Message: TMessage);
    begin
      case Message.Msg of
        WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
          if not (csDesigning in ComponentState) and not Focused then
          begin
            FClicksDisabled := True;
            Windows.SetFocus(Handle);
            FClicksDisabled := False;
            if not Focused then Exit;
          end;
        CN_COMMAND:
          if FClicksDisabled then Exit;
      end;
      inherited WndProc(Message);
    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;
    
    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);
          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);
              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;
    
    procedure TWinControl.WMPaint(var Message: TWMPaint);
    var
      DC, MemDC: HDC;
      MemBitmap, OldBitmap: HBITMAP;
      PS: TPaintStruct;
    begin
      if not FDoubleBuffered or (Message.DC <> 0) then
      begin
        if not (csCustomPaint in ControlState) and (ControlCount = 0) then
          inherited // 执行这里,会执行TWinControl.DefaultHandler,因为TButton和TButtonControl都没有覆盖DefaultHandler函数
        else
          PaintHandler(Message);
      end
      else
      begin
        DC := GetDC(0);
        MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
        ReleaseDC(0, DC);
        MemDC := CreateCompatibleDC(0);
        OldBitmap := SelectObject(MemDC, MemBitmap);
        try
          DC := BeginPaint(Handle, PS);
          Perform(WM_ERASEBKGND, MemDC, MemDC);
          Message.DC := MemDC;
          WMPaint(Message);
          Message.DC := 0;
          BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, SRCCOPY);
          EndPaint(Handle, PS);
        finally
          SelectObject(MemDC, OldBitmap);
          DeleteDC(MemDC);
          DeleteObject(MemBitmap);
        end;
      end;
    end;

    所以就真的没办法,只能执行:

    procedure TWinControl.DefaultHandler(var Message);
    begin
      if FHandle <> 0 then
      begin
        with TMessage(Message) do
        begin
          if (Msg = WM_CONTEXTMENU) and (Parent <> nil) then
          begin
            Result := Parent.Perform(Msg, WParam, LParam);
            if Result <> 0 then Exit;
          end;
          case Msg of
            WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
              Result := SendMessage(LParam, CN_BASE + Msg, WParam, LParam);
            CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
              begin
                SetTextColor(WParam, ColorToRGB(FFont.Color));
                SetBkColor(WParam, ColorToRGB(FBrush.Color));
                Result := FBrush.Handle;
              end;
          else
            if Msg = RM_GetObjectInstance then
              Result := Integer(Self)
            else
            begin
              if Msg <> WM_PAINT then // 稍微改造一下,否则程序执行会出错
              Result := CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam); // 会执行到这里!
            end;
          end;
          if Msg = WM_SETTEXT then
            SendDockNotification(Msg, WParam, LParam);
        end;
      end
      else
        inherited DefaultHandler(Message);
    end;

    执行完TWinControl.DefaultHandler后,程序对TButton的WM_PAINT消息就算处理完毕了,会一路返回。

    百思不得其解的情况下,忽然灵机一动,TButton是封装了微软的Button,虽然其代码不可见,但也应该是正确处理了WM_PAINT消息的,那么只要把WM_PAINT消息发给这个Button的句柄,不就可以正确显示了?这一切,还多亏了CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam);的调用。我想完全屏蔽这句试试效果,结果程序运行出错,因为这样一来许多消息都无法得到处理。那么就加个条件吧:if Msg <> WM_PAINT then 结果发现,两个Button果然灰蒙蒙一片,无法正确显示!但是点击执行事件还是没问题的,而且点击之后,就可以正确显示了,经过研究,又有一番滋味:

    procedure TButtonControl.WndProc(var Message: TMessage);
    begin
      case Message.Msg of
        WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
          if not (csDesigning in ComponentState) and not Focused then
          begin
            FClicksDisabled := True;
            Windows.SetFocus(Handle);
            FClicksDisabled := False;
            if not Focused then Exit;
          end;
        CN_COMMAND:
          if FClicksDisabled then Exit;
      end;
      inherited WndProc(Message);
    end;
    
    procedure TControl.WMLButtonDown(var Message: TWMLButtonDown);
    begin
      SendCancelMode(Self);
      inherited; // 这里,也会调用TWinControl.DefaultHandler,而且传递的消息是WM_LBUTTONDOWN
      if csCaptureMouse in ControlStyle then MouseCapture := True;
      if csClickEvents in ControlStyle then Include(FControlState, csClicked);
      DoMouseDown(Message, mbLeft, []);
    end;
    
    procedure TWinControl.DefaultHandler(var Message);
    begin
      if FHandle <> 0 then
      begin
        with TMessage(Message) do
        begin
          if (Msg = WM_CONTEXTMENU) and (Parent <> nil) then
          begin
            Result := Parent.Perform(Msg, WParam, LParam);
            if Result <> 0 then Exit;
          end;
          case Msg of
            WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
              Result := SendMessage(LParam, CN_BASE + Msg, WParam, LParam);
            CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
              begin
                SetTextColor(WParam, ColorToRGB(FFont.Color));
                SetBkColor(WParam, ColorToRGB(FBrush.Color));
                Result := FBrush.Handle;
              end;
          else
            if Msg = RM_GetObjectInstance then
              Result := Integer(Self)
            else
            begin
              if Msg <> WM_PAINT then // 因为是WM_LBUTTONDOWN,所以照样会传进去
              Result := CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam);
            end;
          end;
          if Msg = WM_SETTEXT then
            SendDockNotification(Msg, WParam, LParam);
        end;
      end
      else
        inherited DefaultHandler(Message);
    end;

    之所以点击以后,会重新出现完整的Button,是因为点击以后,Button的显示情况要变,趁此机会,微软的Button就把它重绘了一遍。真是好复杂呀,好多都是靠猜的。

    经测试,TEdit也是同样的效果(没WM_PAINT函数,没Paint,屏蔽WM_PAINT消息后就无法正确显示)。

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

    理论回答:

    应该是调用的Win32标准控件库,绘制代码应该在comctl32.dll中
    在TWinControl.CreateWnd中调用CreateParams方法指定基本的外观风格
    所以你看TButton有重写CreateParams方法
    绘制是交给系统来做的,如果想更改,就要自绘

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

    新问题:情况1:空窗体放Panel1,不影响

    情况2:空窗体放Panel1和Button1,这时候Panel1就受影响了。什么叫做影响?就是Panel1无法得到正确的绘制。

    目前不知道为什么。

    有那么一点点可能,是拦截了Form1的WM_PAINT,它作为Parent就没有发送消息给子控件。不过TWinControl都是独立的,应该不需要父控件来管理发送呀。

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

    这个,你看一下Panel和Button的CreateParams下的代码
    它们的Style有区别,不知道是不是这里面的原因

    另外,你试试将Windows的主题设置“经典”样式

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

    为什么WM_PAINT不送到BUTTON手里,Windows会誓不罢休?
    任何一个控制,如果没有调用 BeginPaint/EndPaint,Windows都会不罢休

    它拦截了 DefaultHandler 里的 WM_PAINT,但没有处理,Windows 就会不停的重发 WM_PAINT 给它,造成后陆的消息无法得到及时处理
    如果它拦截了,并调用了BeginPaint/EndPaint 处理了,就不会有今晚的问题了

    1. 我明明Panel写在前面,为什么会先发送消息到Button里?
    2. 我拖动窗口的时候,为什么没有消息堵塞的问题?

    Z-Order 这个东西,可以说一个简单的公理,它的定义本身就决定了没有所谓的并行
    Z-Order 是所谓的 Z 轴的顺序,你就想像一下,你排一个队,两个怎么也就有先后


    还在纠结
    我不是说了么
    拖动的时候,直接发送到控件去了
    又一个调度
    第一个整体显示的消息处理调度还在死循环中
    ,你这个排列,那么久说明会先绘制Button,然后绘制Panel,是按照ZOrder绘制的,先绘制前面的
    你把Panel右键设置BringToFront,于是就直接显示了
    ,说的很清楚了啊

  • 相关阅读:
    Xamarin android PreferenceActivity 实现应用程序首选项设置(一)
    xamarin android——数据绑定到控件(四)
    xamarin android——数据绑定到控件(三)
    xamarin android——数据绑定到控件(二)
    xamarin android——数据绑定到控件(一)
    Xamarin 实现android gridview 多选
    Entity Framework Code First 迁移数据库
    Linq to sql 接收存储过程返回的多个结果集
    windows phone URI映射
    element row源码
  • 原文地址:https://www.cnblogs.com/findumars/p/5218421.html
Copyright © 2020-2023  润新知