Delphi-TShape控件解析

原作者: [db:作者] 来自: [db:来源] 收藏邀请

技术交流,DH讲解.

这个控件在Additional选项卡,位于ExtCtrls.pas中.
使用的样子:

这个控件应该就是一个图形控件,所以它应该直接从TGraphicControl继承下来,然后重载Paint方法就可以了,因为也没有其他好做的了.
我们看看源码吧.

type
  //这个控件可以设置形状
  TShapeType = (stRectangle, stSquare, stRoundRect, stRoundSquare,
    stEllipse, stCircle);

  TShape = class(TGraphicControl)
  private
    //笔(画边框) 和 笔刷(填背景)
    FPen: TPen;
    FBrush: TBrush;
    //什么形状
    FShape: TShapeType;
    //属性的方法,设置属性后,调用Invalidate刷新
    procedure SetBrush(Value: TBrush);
    procedure SetPen(Value: TPen);
    procedure SetShape(Value: TShapeType);
  protected
    //关键是这个
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    //这个其实就是Invalidate
    procedure StyleChanged(Sender: TObject);
    property Align;
    property Anchors;
    property Brush: TBrush read FBrush write SetBrush;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Constraints;
    property ParentShowHint;
    property Pen: TPen read FPen write SetPen;
    property Shape: TShapeType read FShape write SetShape default stRectangle;
    property ShowHint;
    property Touch;
    property Visible;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnGesture;
    property OnStartDock;
    property OnStartDrag;
  end;

我们看看设置属性的代码:

procedure TShape.SetBrush(Value: TBrush);
begin
  FBrush.Assign(Value);
end;

procedure TShape.SetPen(Value: TPen);
begin
  FPen.Assign(Value);
end;

procedure TShape.SetShape(Value: TShapeType);
begin
  if FShape <> Value then
  begin
    FShape := Value;
    Invalidate;
  end;
end;

前面2个为什么没有Invalidate?是不是觉得我在忽悠你?嘿嘿,不慌,我们看看Create里面干了什么事?

constructor TShape.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];//这个属性什么用,看我转的上一篇文章ControlStyle的意义吧
  Width := 65;
  Height := 65;
  FPen := TPen.Create;
  FPen.OnChange := StyleChanged;
  FBrush := TBrush.Create;
  FBrush.OnChange := StyleChanged;
end;

destructor TShape.Destroy;
begin
  FPen.Free;
  FBrush.Free;
  inherited Destroy;
end;

看见了设置了Pen和Brush的OnChange事件为StyleChanged,也就是Pen或者Brush有改变就执行StyleChanged方法:

procedure TShape.StyleChanged(Sender: TObject);
begin
  Invalidate;
end;

我之前说了Invalidate是刷新,也就是调用Paint方法,那么我们看看Paint:

procedure TShape.Paint;
var
  X, Y, W, H, S: Integer;
begin
  with Canvas do
  begin
    //设置画布的属性 和TShape一致
    Pen := FPen;
    Brush := FBrush;
    //确定画图区域,起始位置要注意笔的线宽的一半
    X := Pen.Width div 2;
    Y := X;
    W := Width - Pen.Width + 1;
    H := Height - Pen.Width + 1;
    if Pen.Width = 0 then
    begin
      Dec(W);
      Dec(H);
    end;
    if W < H then S := W else S := H;
    //正方形 圆角正方形 和 圆都需要设置长宽一样
    if FShape in [stSquare, stRoundSquare, stCircle] then
    begin
      Inc(X, (W - S) div 2);
      Inc(Y, (H - S) div 2);
      W := S;
      H := S;
    end;
    //最后一步根据 形状 调用不同的Canvas方法画图形
    case FShape of
      stRectangle, stSquare:
        Rectangle(X, Y, X + W, Y + H);
      stRoundRect, stRoundSquare:
        RoundRect(X, Y, X + W, Y + H, S div 4, S div 4);
      stCircle, stEllipse:
        Ellipse(X, Y, X + W, Y + H);
    end;
  end;
end;