TGraphicControl与TControl关键属性方法速记，待修改

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);
begin
  if (Message.DC <> 0) and not (csDestroying in ComponentState) then
  begin
    Canvas.Lock;
    try
      Canvas.Handle := Message.DC;
      try
        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 or ((csDesigning in ComponentState) and
    not (csDesignerHide in ControlState)) and
    not (csNoDesignVisible in ControlStyle)) and (Parent <> nil) and
    Parent.HandleAllocated then
  begin
    Rect := BoundsRect;
    InvalidateRect(Parent.Handle, Rect, not (IsOpaque or
      (csOpaque in Parent.ControlStyle) or BackgroundClipped));
  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 or (csDesigning in ComponentState) and
    not (csNoDesignVisible in ControlStyle)) 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); // 给父类的句柄创建剪裁区
        Parent.PaintControls(DC, Self); // 父类再去画剩余部分，相当于调用 TWinControl.PaintControls(DC: HDC; First: TControl);
      finally
        ReleaseDC(Parent.Handle, DC);
      end;
    end else
    begin
      Invalidate;
      Update;
    end;
end;