VCL中的Shape是個很不錯的控件，可以選擇幾種圖形，以滿足我們的需求，但有時候就是覺得它的可選圖形少了一點，比如我們想要一個三角形，它卻沒有。於是就想到來擴展一下這個控件，名為ShapeEx。其實擴展的功能不多，只是增加了一些圖形。而類也並不是繼承自TShape，而是繼承自TGraphicControl，這樣可以讓我們徹底看看圖形控件的做法。Tshape也是繼承自TGraphicControl。而我們的擴展控件功能是基於Shape的擴展，所以當然裡面的代碼幾乎取之TShape，只是加了一些擴展圖形的代碼，但又有什麼關系呢，VCL源碼是最好的學習資源，我們何不取之用之。
很多東西我們已經在上面說過了，這裡不多說了，我要直入圖形控件的重點。圖形控件不是封裝Windows的控件，而是Delphi自己畫出來的，那麼它肯定有一個畫控件的函數。這個函數就是:
Paint;
看一下VCL源碼，可以知道它定義在TGraphicControl。中：
procedure Paint; virtual;
這是一個虛函數，那麼它的實現是怎麼樣的呢，點擊看它的實現如下：
procedure TGraphicControl.Paint;
begin
end;
裡面什麼碼也沒有，這個很容易理解，因為它不可能知道他的子類的圖形是什麼樣子的。所以設為虛函數，由它的子類來覆蓋它。
那麼是誰調用了這個函數來引起畫控件呢。Windows有一個WM_PAINT;消息，當一切引起重畫的條件發生，則會發送這條消息，再看看TGraphicControl，果然有截獲這個消息：
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
在處理函數裡面，調用了Paint方法，從而實現了畫圖形控件可能：
procedure TGraphicControl.WMPaint(var Message: TWMPaint);
begin
if Message.DC <> 0 then
begin
Canvas.Lock;
try
Canvas.Handle := Message.DC;
try
Paint; //調用了這個函數來畫圖形控件
finally
Canvas.Handle := 0;
end;
finally
Canvas.Unlock;
end;
end;
end;
而它的子類覆蓋了Paint函數，所以消息處理函數調用的實際上是某個子類的Paint方法，這個就是多態的應用了，這裡不多說。
既然Paint函數可以畫圖形控件，那麼它是以什麼來畫的呢，VCL有一個Canvas類，它就是用這個來畫的，在TGraphicControl果然也定義了這個成員：
FCanvas: TCanvas;
property Canvas: TCanvas read FCanvas;
可以看出這是一個只讀的成員，因為它不想外界來影響他。
好了，一切已經具備了，現在就可以畫上去了。源代碼有詳細解釋，這裡不多說。
在ShapeEx中有兩個對象屬性，為Pen和Brush。對應於他的兩個對象成員。設置了這兩個屬性之後，在對象察看器中就可以展開他們來設置他們的屬性了。這個也是對象屬性的一般用法。
似乎沒有什麼可說的了，下面看源代碼吧，其中也有很詳細的說明：
unit shapeExUnit;
interface
uses
SysUtils,Classes,Graphics,Controls,ExtCtrls;
type
//定義了幾種形狀：矩形，正方形，圓角矩形，圓角正方形，橢圓形，圓形，
//增加的圖形：橫線，堅線，上三角形，菱形
TShapeType = (stRectangle, stSquare, stRoundRect, stRoundSquare,
stEllipse, stCircle,stHLine,stVLine,stTriangle,stDiamond);
TShapeEx = class(TGraphicControl)
private
FPen: TPen;
FBrush: TBrush;
FShape: TShapeType;
procedure SetBrush(Value: TBrush);
procedure SetPen(Value: TPen);
procedure SetShape(Value: TShapeType);
protected
//最重要的函數，在父類TGraphicControl中定義的一個
//虛函數，當得到WM_PAINT消息時，調用該函數引起重畫
//父類是一個空函數，以便TGraphicControl的子類復蓋它。
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
//這個函數當圖形中的畫筆和畫刷改變時引起重畫，在設計器中最為明顯
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 Visible;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
implementation
//構造函數，ControlStyle確定控件的特征，這裡是加上csReplicatable
//使該控件可以用PaintTo方法把它畫到一個任意的畫布中
//另外還指定Pen和Brush對象的OnChange事件的方法指針給StyleChanged;
constructor TShapeEx.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
Width := 65;
Height := 65;
FPen := TPen.Create;
FPen.OnChange := StyleChanged;
FBrush := TBrush.Create;
FBrush.OnChange := StyleChanged;
end;
destructor TShapeEx.Destroy;
begin
FPen.Free;
FBrush.Free;
inherited Destroy;
end;
//最重要函數，控件就是以這個函數畫出來的。
procedure TShapeEx.Paint;
var
//X:左上角X， Y：左上角Y， W：寬， Y：高 S：寬高中大的值
X, Y, W, H, S: Integer;
begin
//Canvas是父類TGraphicControl的屬性，用於畫控件
//在畫圖之前，要進行一些坐標點的確定，
with Canvas do
begin
//如果以控件的四個角來畫圖形，當Pen太大時，圖形的邊線
//將比Pen的寬要小一些，所以要進行點的重定位。
Pen := FPen;
Brush := FBrush;
X := Pen.Width div 2;
Y := X;
W := Width - Pen.Width + 1;
H := Height - Pen.Width + 1;
//Pen.width的值為0和為1時是一樣的等於一個象素
//如果上面Pen.width等於1，則圖形的寬高剛好等於控件的寬高
//如果為0，則圖形寬高要大於控件寬高一個象素了，所以有了下面的語句
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;
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);
//以下是增加的部分。
stHLine:
begin
MoveTo(X, Height div 2);
LineTo(X+W,Height div 2);
end;
stVLine:
begin
MoveTo(Width div 2,Y);
LineTo(Width div 2,Y+H);
end;
stTriangle:
Polygon([Point(X,Y+H-1),Point(X+W-1,Y+H-1),Point(Width div 2,Y)]);
stDiamond:
Polygon([Point(Width div 2,Y),Point(X,Height div 2),
Point(Width div 2,Y+H-1),Point(X+W-1, Height div 2)]);
end;
end;
end;
//Invalidate這個函數將使系統發送WM_PAINT給TGraphicControl
//TGraphicControl的處理函數將調用Paint，而它的子類覆蓋了它
//所以實際就調用了ShapeEx的Paint函數，從而達到了重畫的效果
procedure TShapeEx.StyleChanged(Sender: TObject);
begin
Invalidate;
end;
procedure TShapeEx.SetBrush(Value: TBrush);
begin
FBrush.Assign(Value);
end;
procedure TShapeEx.SetPen(Value: TPen);
begin
FPen.Assign(Value);
end;
//設置圖形，同時引起重畫，以達到圖形變化，
//最明顯的效果是在設計器時改變Shape屬性時看到的變化
procedure TShapeEx.SetShape(Value: TShapeType);
begin
if FShape <> Value then
begin
FShape := Value;
Invalidate;
end;
end;
end.
安裝等方法在上一章已經說過了，這裡不多說。這一次知道了圖形控件的大概做法，其實無非就是覆蓋Paint來畫自己的圖形控件，而其他，則和我們上一章的說過的一樣。其實也很簡單。
以上兩個控件算是比較簡單，但已經講清了很多組件制作的概念和技巧，看不看得懂就由你了，我也沒有辦法。有一個有用的技巧就是多看看VCL的源碼，你會學到更多的東西。
接下來，應該要做一個難一點了吧。想知道是什麼，且聽下回分解。
