开发Delphi控件入门示例：图形控件(修改版)

 

示例：Delphi图形控件Shapes开发示例。


Shapes.pas源码
unit Shapes;

interface

  uses SysUtils, WinTypes, WinProcs, Messages, Classes,Graphics,Controls,Forms;
type
  //画哪几种形状
  TSampleShapeType=(sstRectangle, sstSquare, sstRoundRect,
              sstRoundSquare, sstEllipse, sstCircle);

  TSampleShape=class(TGraphicControl)

  private
  //加"_"目的：此处是为了更明显的说明问题
    _version:String;

    //私有成员(功能：保存值，供内部使用)
    FShape: TSampleShapeType;

    {[Pen/Brush]owned对象:在缺省情况下，一个Canvas具有一个细的、黑笔和实心的白刷，
          为了使用户在使用Shape控制时能改变Canvas的这些性质，必须能在设计时
          提供这些对象；然后在画时使用这些对象，这样附属的Pen或Brush被称为Owned对象。
    }
    FPen: TPen;
    FBrush: TBrush;

    //私有方法(供内部调用)
    procedure SetShape(value: TSampleShapeType);
    procedure SetBrush(Value: TBrush);
    procedure SetPen(Value: TPen);

    //处理Pen和Brush发生改变时对Shape控制的重画问题
    procedure StyleChanged(Sender: TObject);
    procedure SetVersion(const Value: String);

  public
  //Create：1.设置默认值 2.创建内部含有的对象 3.关联事件
  constructor Create(Aowner: TComponent); override;
  //destructor:释放对象
  destructor destroy; override;
    
  protected
  //(摘录):图形控制基本要素是在屏幕上画图形的方法。
  //抽象类TGraphicControl定义了名为Paint的虚方法，可以覆盖该方法来画所要的图形。
  procedure Paint; override;

  //published区内的都是在设计时显示在Object Inspector
  
  //其中：属性在第一页，事件在第二页
  //直接书写(如Height):当普通变量用，不同的是显示在Object Inspector中

  //存取私有成员(如_version)，则是：显示为属性名称(Version)，读取是直接读取，写是通过write指定方法SetVersion。
  published

  property Height default 65;
  property Width default 65;

  //发布在published后才能在Object Inspector中显示出来
  property Shape: TSampleShapeType read FShape write SetShape;
  property Brush: TBrush read FBrush write SetBrush;
  property Pen: TPen read FPen write SetPen;
  property Version: String read _version write SetVersion;

  //事件继承和声明
  property DragCursor;
  property DragMode;
  property OnDragDrop;
  property OnDragOver;
  property ONEndDrag;
  property OnMouseDown;
  property OnMouseMove;
  property OnMouseup;

end;

procedure Register;

var SampleShape:TSampleShape;

implementation



{ TSampleShape }

constructor TSampleShape.Create(Aowner: TComponent);
begin
inherited Create(AOwner);
width := 65;
Height := 65;
FPen := TPen.Create;
FBrush := TBrush.Create;
FBrush.OnChange := StyleChanged;
FPen.OnChange:=StyleChanged;
end;

destructor TSampleShape.destroy;
begin
FPen.Free;
FBrush.Free;
inherited destroy;
end;

procedure TSampleShape.Paint;
begin
inherited;
with Canvas do
begin
    Pen := FPen;
    Brush := FBrush;
    case FShape of
        sstRectangle, sstSquare :
        Rectangle(0, 0, Width, Height);
        sstRoundRect, sstRoundSquare:
        RoundRect(0, 0, Width, Height, Width div 4, Height div 4);
        sstCircle, sstEllipse:
        Ellipse(0, 0, Width, Height);
    end;
end;

end;

//Value:是规定的接受值
procedure TSampleShape.SetBrush(Value: TBrush);
begin
FBrush.Assign(Value);
end;

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

procedure TSampleShape.SetShape(value: TSampleShapeType);
begin
  if FShape<>value then
  begin
  FShape := value;
    { 强制新形状的重画 }
  Invalidate;
  end;
end;

procedure TSampleShape.SetVersion(const Value: String);
begin
self._version:=Value;
end;

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

procedure Register;
begin
RegisterComponents('Samples',[TSampleShape]);
end;

end.