TWinControl.DefaultHandler里的CallWindowProc还挺有深意的，TButton对WM_PAINT消息的处理就是靠它来处理的（以前不明白为什么总是要调用inherite

Posted 2020-06-16

我忽然发现：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就把它重绘了一遍。真是好复杂呀，好多都是靠猜的。