我忽然发现: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就把它重绘了一遍。真是好复杂呀,好多都是靠猜的。
时间: 2024-12-20 01:07:53