当前位置：首页 >> delphi >> 组件制作之三（图形控件)_Delphi教程_src119.com

组件制作之三（图形控件)_Delphi教程_src119.com -

VCL中的Shape是个很不错的控件，可以选择几种图形，以满足我们的需求，但有时候就是觉得它的可选图形少了一点，比如我们想要一个三角形，它却没有。于是就想到来扩展一下这个控件，名为ShapeEx。其实扩展的功能不多，只是增加了一些图形。而类也并不是继承自TShape，而是继承自TGraphicControl，这样可以让我们彻底看看图形控件的做法。Tshape也是继承自TGraphicControl。而我们的扩展控件功能是基于Shape的扩展，所以当然里面的代码几乎取之TShape，只是加了一些扩展图形的代码，但又有什么关系呢，VCL源码是最好的学习资源，我们何不取之用之。

很多东西我们已经在上面说过了，这里不多说了，我要直入图形控件的重点。图形控件不是封装Windows的控件，而是Delphi自己画出来的，那么它肯定有一个画控件的函数。这个函数就是:

Paint;

看一下VCL源码，可以知道它定义在TGraphicControl。中：

rocedure aint virtual

这是一个虚函数，那么它的实现是怎么样的呢，点击看它的实现如下：

procedure TGraphicControl.Paint;

begin

end;

里面什么码也没有，这个很容易理解，因为它不可能知道他的子类的图形是什么样子的。所以设为虚函数，由它的子类来覆盖它。

那么是谁调用了这个函数来引起画控件呢。Windows有一个WM_PAINT;消息，当一切引起重画的条件发生，则会发送这条消息，再看看TGraphicControl，果然有截获这个消息：

procedure WMPaint(var Me age: TWMPaint) me age WM_PAINT;

在处理函数里面，调用了Paint方法，从而实现了画图形控件可能：

procedure TGraphicControl.WMPaint(var Me age: TWMPaint);

begin

if Me age.DC lt gt 0 then

egin

Canvas.Lock;

try

Canvas.Handle := Me age.DC;

try

aint //调用了这个函数来画图形控件

finally

Canvas.Handle := 0;

end;

finally

Canvas.Unlock;

end;

end;

end;

而它的子类覆盖了Paint函数，所以消息处理函数调用的实际上是某个子类的Paint方法，这个就是多态的应用了，这里不多说。

既然Paint函数可以画图形控件，那么它是以什么来画的呢，VCL有一个Canvas类，它就是用这个来画的，在TGraphicControl果然也定义了这个成员：

FCanvas: TCanva

property Canvas: TCanva read FCanva

可以看出这是一个只读的成员，因为它不想外界来影响他。

好了，一切已经具备了，现在就可以画上去了。源代码有详细解释，这里不多说。

在ShapeEx中有两个对象属性，为Pen和Brush。对应于他的两个对象成员。设置了这两个属性之后，在对象察看器中就可以展开他们来设置他们的属性了。这个也是对象属性的一般用法。

似乎没有什么可说的了，下面看源代码吧，其中也有很详细的说明：

unit hapeExUnit;

interface

uses

ysUtils,Cla es,Graphics,Controls,ExtCtrl

type

//定义了几种形状：矩形，正方形，圆角矩形，圆角正方形，椭圆形，圆形，

//增加的图形：横线，坚线，上三角形，菱形

TShapeType = (stRectangle, tSquare, tRoundRect, tRoundSquare,

tElli e, tCircle,stHLine,stVLine,stTriangle,stDiamond);

TShapeEx = cla (TGraphicControl)

rivate

FPen: TPe

FBrush: TBrush;

FShape: TShapeType;

rocedure etBrush(Value: TBrush);

rocedure etPen(Value: TPen);

rocedure etShape(Value: TShapeType);

rotected

//最重要的函数，在父类TGraphicControl中定义的一个

//虚函数，当得到WM_PAINT消息时，调用该函数引起重画

//父类是一个空函数，以便TGraphicControl的子类复盖它。

rocedure aint override;

ublic

co tructor Create(AOwner: TComponent) override;

destructor Destroy override;

ublished

//这个函数当图形中的画笔和画刷改变时引起重画，在设计器中最为明显

rocedure tyleChanged(Sender: TObject);

roperty Alig

roperty Anchor

roperty rush: TBrush read FBrush write etBrush;

roperty DragCursor;

roperty DragKind;

roperty DragMode;

roperty Enabled;

roperty Co traint

roperty arentShowHint;

roperty en: TPe read FPe write etPe

roperty hape: TShapeType read FShape write etShape default tRectangle;

roperty howHint;

roperty Visible;

roperty OnContextPopu

roperty OnDragDro

roperty OnDragOver;

roperty OnEndDock;

roperty OnEndDrag;

roperty OnMouseDow

roperty OnMouseMove;

roperty OnMouseU

roperty O tartDock;

roperty O tartDrag;

end;

implementation

//构造函数，ControlStyle确定控件的特征，这里是加上csReplicatable

//使该控件可以用PaintTo方法把它画到一个任意的画布中

//另外还指定Pen和Brush对象的OnChange事件的方法指针给StyleChanged;

co tructor TShapeEx.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

ControlStyle := ControlStyle + [csReplicatable];

Width := 65;

Height := 65;

FPe := TPen.Create;

FPen.OnChange := tyleChanged;

FBrush := TBrush.Create;

FBrush.OnChange := tyleChanged;

end;

destructor TShapeEx.Destroy;

begin

FPen.Free;

FBrush.Free;

inherited Destroy;

end;

//最重要函数，控件就是以这个函数画出来的。

procedure TShapeEx.Paint;

var

//X:左上角X， Y：左上角Y， W：宽， Y：高：宽高中大的值

X, Y, W, H, : Integer;

begin

//Canvas是父类TGraphicControl的属性，用于画控件

//在画图之前，要进行一些坐标点的确定，

with Canva do

egin

//如果以控件的四个角来画图形，当Pen太大时，图形的边线

//将比Pen的宽要小一些，所以要进行点的重定位。

e := FPe

rush := FBrush;

X := en.Width div 2;

Y := X;

W := Width - en.Width + 1;

H := Height - en.Width + 1;

//Pen.width的值为0和为1时是一样的等于一个象素

//如果上面Pen.width等于1，则图形的宽高刚好等于控件的宽高

//如果为0，则图形宽高要大于控件宽高一个象素了，所以有了下面的语句

if en.Width = 0 then

egin

Dec(W);

Dec(H);

end;

if W lt H the := W else := H;

//当图形为正方类型的图形时，需要对图形的位置进行一些调整

if FShape i [stSquare, tRoundSquare, tCircle] then

egin

Inc(X, (W - ) div 2);

Inc(Y, (H - ) div 2);

W :=

H :=

end;

case FShape of

tRectangle, tSquare:

Rectangle(X, Y, X + W, Y + H);

tRoundRect, tRoundSquare:

RoundRect(X, Y, X + W, Y + H, div 4, div 4);

tCircle, tElli e:

Elli e(X, Y, X + W, Y + H);

//以下是增加的部分。

tHLine:

egin

MoveTo(X, Height div 2);

LineTo(X+W,Height div 2);

end;

tVLine:

egin

MoveTo(Width div 2,Y);

LineTo(Width div 2,Y+H);

end;

tTriangle:

olygon([Point(X,Y+H-1),Point(X+W-1,Y+H-1),Point(Width div 2,Y)]);

tDiamond:

olygon([Point(Width div 2,Y),Point(X,Height div 2),

oint(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.A ign(Value);

end;

procedure TShapeEx.SetPen(Value: TPen);

begin

FPen.A ign(Value);

end;

//设置图形，同时引起重画，以达到图形变化，

//最明显的效果是在设计器时改变Shape属性时看到的变化

procedure TShapeEx.SetShape(Value: TShapeType);

begin

if FShape lt gt Value then

egin

FShape := Value;

Invalidate;

end;

end;

end.

安装等方法在上一章已经说过了，这里不多说。这一次知道了图形控件的大概做法，其实无非就是覆盖Paint来画自己的图形控件，而其他，则和我们上一章的说过的一样。其实也很简单。

以上两个控件算是比较简单，但已经讲清了很多组件制作的概念和技巧，看不看得懂就由你了，我也没有办法。有一个有用的技巧就是多看看VCL的源码，你会学到更多的东西。

接下来，应该要做一个难一点了吧。想知道是什么，且听下回分解。