继承自TWinControl的控件不能在设计期间接受子控件,用代码设置子控件却可以(它的自绘是直接改写PaintWindow虚函数,而不是覆盖Paint函数——对TWinControl.WMPaint又有新解了)

这个控件直接继承自TWinControl,因此不是改写Paint;函数,而是直接改写PaintWindow虚函数,它在VCL框架里被直接调用,直接就把自己画好了(不用走给控件Perform(WM_Paint)的路线了),很有意思。

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

unit MyWinControl;

interface

uses
SysUtils, Classes, Controls, Windows;

type
TMyWinControl = class(TWinControl)
protected
procedure PaintWindow(DC: HDC); override;
public
constructor Create(AOwner: TComponent); override;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TMyWinControl]);
end;

constructor TMyWinControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlState := ControlState + [csCustomPaint]; // 强行加上了自绘条件,改变了自绘的走向,使用这种方法,控件不需要处理WM_PAINT消息(不需要WMPaint函数和Paint函数)
// 必须通知 WMPaint 需要画自己
end;

procedure TMyWinControl.PaintWindow(DC: HDC);
var
Rect: TRect;
begin
Windows.GetClientRect(Handle, Rect);
FillRect(DC, Rect, COLOR_BTNSHADOW + 1);
SetBkMode(DC, TRANSPARENT);
DrawText(DC, 'Hello, TMyWinControl', -1, Rect, DT_SINGLELINE or DT_VCENTER or DT_CENTER);
end;

end.

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

但代码指定子控件则可以,而且还能跟随父控件一起销毁:

procedure TForm1.Button1Click(Sender: TObject);
begin
button2.Parent:=MyWinControl1;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
MyWinControl1.Destroy;
end;

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

不使用Paint()的原因也比较清楚(TWinControl根本没有Paint函数):

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 // 优先找子类的WM_PAINT消息函数,找不到就调用DefaultHandler函数,这么说,所有TWinControl(非TCustomControl)都处理了WM_PAINT消息?
    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.PaintHandler(var Message: TWMPaint);
var
  I, Clip, SaveIndex: Integer;
  DC: HDC;
  PS: TPaintStruct;
begin
  DC := Message.DC;
  if DC = 0 then DC := BeginPaint(Handle, PS);
  try
    if FControls = nil then PaintWindow(DC) else // 一般情况下,这样执行就结束了
    begin
      SaveIndex := SaveDC(DC);
      Clip := SimpleRegion;
      for I := 0 to FControls.Count - 1 do
        with TControl(FControls[I]) do
          if (Visible or (csDesigning in ComponentState) and
            not (csNoDesignVisible in ControlStyle)) and
            (csOpaque in ControlStyle) then
          begin
            Clip := ExcludeClipRect(DC, Left, Top, Left + Width, Top + Height);
            if Clip = NullRegion then Break;
          end;
      if Clip <> NullRegion then PaintWindow(DC);
      RestoreDC(DC, SaveIndex);
    end;
    PaintControls(DC, nil);
  finally
    if Message.DC = 0 then EndPaint(Handle, PS);
  end;
end;

procedure TWinControl.PaintWindow(DC: HDC); // 这个函数等于没用(它是virtual函数),必须覆盖
var
  Message: TMessage;
begin
  Message.Msg := WM_PAINT;
  Message.WParam := DC;
  Message.LParam := 0;
  Message.Result := 0;
  DefaultHandler(Message);
end;
原文地址:https://www.cnblogs.com/findumars/p/3931703.html