TGraphicControl(自绘就2步,直接自绘自己,不需要调用VCL框架提供的函数重绘所有子控件,也不需要自己来提供PaintWindow函数让管理框架来调用)与TControl关键属性方法速记(Repaint要求父控件执行详细代码来重绘自己,还是直接要求Invalidate无效后Update刷新父控件,就看透明不透明这个属性,因为计算显示的区域有所不同)

TGraphicControl = class(TControl)
  private
    FCanvas: TCanvas;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
    procedure Paint; virtual;
    property Canvas: TCanvas read FCanvas; // 到这步才有
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

constructor TGraphicControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TControlCanvas.Create; // 相互捆绑
  TControlCanvas(FCanvas).Control := Self;
end;

destructor TGraphicControl.Destroy;
begin
  if CaptureControl = Self then SetCaptureControl(nil);
  FCanvas.Free;
  inherited Destroy;
end;

procedure TGraphicControl.WMPaint(var Message: TWMPaint); // 第一步,收到WM_PAINT消息
begin
  if (Message.DC <> 0) and not (csDestroying in ComponentState) then
  begin
    Canvas.Lock;
    try
      Canvas.Handle := Message.DC;
      try
        Paint; // 第二步,调用自己的Paint虚函数
      finally
        Canvas.Handle := 0;
      end;
    finally
      Canvas.Unlock;
    end;
  end;
end;

procedure TGraphicControl.Paint; // 提前准备:提前由程序员覆盖(目前是空函数)
begin
end;

TControl处理所有鼠标消息 + 位置,字体,对齐,Enable等等 + 部分消息处理。感觉内容比较简单,精华不在这里。

  TControl = class(TComponent)
    FParent: TWinControl;
    FWindowProc: TWndMethod;
    FControlStyle: TControlStyle;
    FControlState: TControlState;
    FParentFont: Boolean;
    FParentColor: Boolean;

    FLeft: Integer;
    FTop: Integer;
    FWidth: Integer;
    FHeight: Integer;
    FVisible: Boolean;
    FEnabled: Boolean;
    FIsControl: Boolean;
    FFont: TFont;
    FColor: TColor;
    FHint: string;
    FText: PChar;

    FOnClick: TNotifyEvent;
    FOnDblClick: TNotifyEvent;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
    procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure WMMButtonDown(var Message: TWMMButtonDown); message WM_MBUTTONDOWN;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMRButtonDblClk(var Message: TWMRButtonDblClk); message WM_RBUTTONDBLCLK;
    procedure WMMButtonDblClk(var Message: TWMMButtonDblClk); message WM_MBUTTONDBLCLK;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
    procedure WMMButtonUp(var Message: TWMMButtonUp); message WM_MBUTTONUP;
    procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
    procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;

    procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE;
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
    procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;

    procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
    procedure CMMouseActivate(var Message: TCMMouseActivate); message CM_MOUSEACTIVATE;
    procedure CMParentFontChanged(var Message: TCMParentFontChanged); message CM_PARENTFONTCHANGED;
    procedure CMSysFontChanged(var Message: TMessage); message CM_SYSFONTCHANGED;
    procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
    procedure CMParentShowHintChanged(var Message: TMessage); message CM_PARENTSHOWHINTCHANGED;
    procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
    procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
    procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
    procedure CMParentBiDiModeChanged(var Message: TMessage); message CM_PARENTBIDIMODECHANGED;
    procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL;
    procedure CMGesture(var Message: TCMGesture); message CM_GESTURE;
    procedure CMParentTabletOptionsChanged(var Message: TMessage); message CM_PARENTTABLETOPTIONSCHANGED;


    procedure Click; dynamic;
    procedure DblClick; dynamic;
    function GetClientRect: TRect; virtual;
    procedure Loaded; override;


    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BringToFront;
    function GetParentComponent: TComponent; override;
    function HasParent: Boolean; override;
    procedure SetTextBuf(Buffer: PChar);

    function ClientToScreen(const Point: TPoint): TPoint;
    function ClientToParent(const Point: TPoint; AParent: TWinControl = nil): TPoint;
    procedure Hide;

    procedure Refresh;
    procedure Repaint; virtual;
    procedure Show;
    procedure Update; virtual;

    function DesignWndProc(var Message: TMessage): Boolean; dynamic;
    procedure WndProc(var Message: TMessage); virtual; // 处理了不少消息
    procedure DefaultHandler(var Message); override;
    function Perform(Msg: Cardinal; WParam: WPARAM; LParam: PChar): LRESULT; overload;
    function Perform(Msg: Cardinal; WParam: WPARAM; var LParam: TRect): LRESULT; overload;

    property WindowProc: TWndMethod read FWindowProc write FWindowProc;
    property Parent: TWinControl read FParent write SetParent;
procedure TControl.Invalidate;
begin
  InvalidateControl(Visible, csOpaque in ControlStyle);
end;

procedure TControl.InvalidateControl(IsVisible, IsOpaque: Boolean);
begin
  if (IsVisible) and (Parent <> nil) and
    Parent.HandleAllocated then
  begin
    Rect := BoundsRect;
    InvalidateRect(Parent.Handle, Rect, not (IsOpaque or
      (csOpaque in Parent.ControlStyle) or BackgroundClipped)); // API 使得父控件的部分区域失效
  end;
end;

// (非重载)显示自己
procedure TControl.Show;
begin
  if Parent <> nil then Parent.ShowControl(Self);
  if not (csDesigning in ComponentState) or
    (csNoDesignVisible in ControlStyle) then Visible := True;
end;

// (重载)通知父控件刷新(注意,它的父类是一个TWinControl)
// 貌似挺巧妙,因为重载,所以先调用了TWinControl.Update 后面就不是当前类管的事情了。 
// 但是单独的TWinControl子控件重载了Update消息,所以不会用到它。
// 也许TGraphicControl 才会用到TControl.Update; ?
procedure TControl.Update;
begin
  if Parent <> nil then Parent.Update;
end;


// (非重载)表面上看多此一举,但它其实可以调用子类的Repaint(通用方法)
procedure TControl.Refresh;
begin
  Repaint;
end;

// (重载)计算剪裁区域以后,还是发给了父类去重绘。父类的PaintControls会给每一个子控件发WM_PAINT消息。
// 每个子控件都用Handle区分。而消息队列是线程为载体的,所以不矛盾
// 所以调用TControl.Repaint;来刷新也没有问题。单独的TWinControl子控件重载了Repaint消息,所以不会用到它。
// 也许TGraphicControl 才会用到TControl.Repaint; ?
procedure TControl.Repaint;
var
  DC: HDC;
begin
  if (Visible) and (Parent <> nil) and // 当前控件可显示
    Parent.HandleAllocated then
    if csOpaque in ControlStyle then // 当前控件不透明(即需要显示)
    begin
      DC := GetDC(Parent.Handle); // 取得父类的句柄(注意,它的父类是一个TWinControl)
      try
        IntersectClipRect(DC, Left, Top, Left + Width, Top + Height); // API 给父类的句柄创建剪裁区
        Parent.PaintControls(DC, Self); // 父类再去画剩余部分,相当于调用 TWinControl.PaintControls(DC: HDC; First: TControl);
      finally
        ReleaseDC(Parent.Handle, DC);
      end;
    end else // 如果当前控件透明,就是失效后立刻刷新显示(即当前控件的图形没有变化,只是需要重新刷新显示的问题)
    begin
      Invalidate; // 存在要求显示(透明的情况下)
      Update;
    end;
end;

 对比一下TWinControl.Repaint函数,思考为什么不透明的时候,会多了一段详细的自绘代码?

procedure TWinControl.Repaint;
begin
  Invalidate;
  Update;
end;

说白了就是重新裁剪,而且是对父控件的DC进行重新剪裁。我估计,这里的代码怕的是,图形控件既显示(visible),又不透明(csOpaque)的情况下,图形本身的大小随时可能会变,所以每次都需要重新剪裁。而不透明的情况下,不存在这个问题,所以直接刷新就行了。

但是新问题又来了,剪裁以后,居然没有要求使无效和刷新,为什么呢?通过查询TWinControl.PaintControls的代码得知:

procedure TWinControl.PaintControls(DC: HDC; First: TControl);
var
  I, Count, SaveIndex: Integer;
  FrameBrush: HBRUSH;
begin
  if DockSite and UseDockManager and (DockManager <> nil) then
    DockManager.PaintSite(DC);
  if FControls <> nil then
  begin
    I := 0;
    if First <> nil then
    begin
      I := FControls.IndexOf(First);
      if I < 0 then I := 0;
    end;
    Count := FControls.Count;
    while I < Count do
    begin
      with TControl(FControls[I]) do
        if (Visible or (csDesigning in ComponentState) and
          not (csNoDesignVisible in ControlStyle)) and
          RectVisible(DC, Rect(Left, Top, Left + Width, Top + Height)) then
        begin
          if csPaintCopy in Self.ControlState then
            Include(FControlState, csPaintCopy);
          SaveIndex := SaveDC(DC);
          MoveWindowOrg(DC, Left, Top);
          IntersectClipRect(DC, 0, 0, Width, Height);
          Perform(WM_PAINT, DC, 0);
          RestoreDC(DC, SaveIndex);
          Exclude(FControlState, csPaintCopy);
        end;
      Inc(I);
    end;
  end;
  if FWinControls <> nil then
    for I := 0 to FWinControls.Count - 1 do
      with TWinControl(FWinControls[I]) do
        if FCtl3D and (csFramed in ControlStyle) and
          (Visible or (csDesigning in ComponentState) and
          not (csNoDesignVisible in ControlStyle)) then
        begin
          FrameBrush := CreateSolidBrush(ColorToRGB(clBtnShadow));
          FrameRect(DC, Rect(Left - 1, Top - 1, Left + Width, Top + Height),
            FrameBrush);
          DeleteObject(FrameBrush);
          FrameBrush := CreateSolidBrush(ColorToRGB(clBtnHighlight));
          FrameRect(DC, Rect(Left, Top, Left + Width + 1, Top + Height + 1),
            FrameBrush);
          DeleteObject(FrameBrush);
        end;
end;

当场就要求所有图形子控件执行WM_PAINT,即模拟图形控件收到WM_PAINT,即立刻要求全部重绘,所以也就不必使无效和刷新了。

做个实验测试一下,看是不是图形控件剪裁区域变化以后的问题(确实当场起作用了):

procedure TForm1.Button2Click(Sender: TObject);
begin
  image1.Width :=100;
end;

property Width: Integer read FWidth write SetWidth;

procedure TControl.SetWidth(Value: Integer);
begin
  SetBounds(FLeft, FTop, Value, FHeight);
  Include(FScalingFlags, sfWidth);
end;

procedure TControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if CheckNewSize(AWidth, AHeight) and
    ((ALeft <> FLeft) or (ATop <> FTop) or
    (AWidth <> FWidth) or (AHeight <> FHeight)) then
  begin
    InvalidateControl(Visible, False); // TControl的函数,注意这里的osPraque是false,即当前控件处于透明状态。
    FLeft := ALeft;
    FTop := ATop;
    FWidth := AWidth;
    FHeight := AHeight;
    UpdateAnchorRules;
    Invalidate; // TControl的函数,为什么要失效两遍?因为长宽高可能变化了。
    Perform(WM_WINDOWPOSCHANGED, 0, 0);
    RequestAlign;
    if not (csLoading in ComponentState) then Resize;
  end;
end;

procedure TControl.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
  inherited;
  { Update min/max width/height to actual extents control will allow }
  if ComponentState * [csReading, csLoading] = [] then
  begin
    with Constraints do
    begin
      if (MaxWidth > 0) and (Width > MaxWidth) then
        FMaxWidth := Width
      else if (MinWidth > 0) and (Width < MinWidth) then
        FMinWidth := Width;
      if (MaxHeight > 0) and (Height > MaxHeight) then
        FMaxHeight := Height
      else if (MinHeight > 0) and (Height < MinHeight) then
        FMinHeight := Height;
    end;
    if Message.WindowPos <> nil then
      with Message.WindowPos^ do
        if (FHostDockSite <> nil) and not (csDocking in ControlState)  and
          (Flags and SWP_NOSIZE = 0) and (cx <> 0) and (cy <> 0) then
          CalcDockSizes;
  end;
end;

问题:我不明白,Form1是什么收到的WM_PAINT消息,使得Image1被重绘的?

回答:系统空闲时候探测无效区域,发现有,就立刻发送WM_PAINT消息。

Invalidate 发起消息, 在下一个消息循环就会知道要 paint

Invalidate之后,系统会选择一个时间发送WM_PAINT消息。

系统会在需要重绘的时候计算需要重绘的Region,然后发送WM_PAINT给相应窗口

我刚才没想起来 一头钻到updateWindow这种直接调用的思维里去了

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

最后:Reflesh是通用方法,但其实扰乱思路,不用管