如何写一个箭头控件？（有焦点的）(100分)

如何写一个箭头控件？要求：要能够朝向任意方向，可以用鼠标控制箭头的起点育终点，
可以拖动箭头，最重要的是：：：箭头线条以外的区域不能遮住其他控件！

现在我是这样写的：从TCustomControl继承，用SetWindowRgn设定区域。
但问题是：PathToRegion不行，因为它不能记录Rectangle、LineTo等Pen画出来的Path,
(虽然帮助文件说可以)。

我不从TGraphicControl继承有以下原因：
1。没有焦点，现在我的箭头的要求是，获得焦点以后，可以用鼠标控制箭头的起点与终点，可以拖动箭头，并且，获得焦点以后的箭头外观与获得焦点以前是不一样的：两边有用于控制的方框。
2。有句柄，可以收消息，所以从TCustomControl继承。

请教诸位有什么高招

是不是要做仪表控件？www.51delphi.com 上有几个套件可以参考一下

{**************************************************************************}
{ }
{ Delphi Visual Shapes }
{ }
{ Copyright (c) 1998 by DithoSoft }
{ }
{**************************************************************************}
unit Shapes;
{$R-,W-,S-}

interface

uses
Windows, Messages,stdCtrls, SysUtils, Classes, Controls, Forms, Dialogs, Graphics;

type
//////////////////////////////////添加标签 ///////////////////////////////
//////////////////////////////////////////////////////////////////////////
{ TBoundLabel }

TBoundLabel = class(TCustomLabel)
private
function GetTop: Integer;
function GetLeft: Integer;
function GetWidth: Integer;
function GetHeight: Integer;
procedure SetHeight(const Value: Integer);
procedure SetWidth(const Value: Integer);
protected
procedure AdjustBounds; override;
public
constructor Create(AOwner: TComponent); override;
published
property BiDiMode;
property Caption;
property Color;
property DragCursor;
property DragKind;
property DragMode;
property Font;
property Height: Integer read GetHeight write SetHeight;
property Left: Integer read GetLeft;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property Top: Integer read GetTop;
property Transparent;
property Layout;
property WordWrap;
property Width: Integer read GetWidth write SetWidth;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseEnter;
property OnMouseLeave;
property OnStartDock;
property OnStartDrag;
end;

TLabelPosition = (lpCenter,lpAbove, lpBelow, lpLeft, lpRight);
//////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////

{ TCustomShape }
TCustomShape = class(TGraphicControl)
private
FBrush : TBrush;
FPen : TPen;
FShadow : Boolean;
FShadowOffset : Cardinal;
FShadowColor : TColor;

///////////////////////添加鼠标进入事件
FOnMouseLeave: TNotifyEvent;
FOnMouseEnter: TNotifyEvent;

procedure ChangeRedraw(Sender: TObject);
procedure SetBrush(Value: TBrush);
procedure SetPen(Value: TPen);
procedure SetShadow(Value: Boolean);
procedure SetShadowOffset(Value: Cardinal);
procedure SetShadowColor(Value: TColor);

///////////////////////添加鼠标进入事件
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
protected
procedure Paint; override;
procedure PaintShadow; virtual;
procedure PaintShape; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

///////////////////////添加鼠标进入事件
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
published
property Align;
property Brush: TBrush read FBrush write SetBrush;
property DragCursor;
property DragMode;
property Enabled;
property ParentShowHint;
property Pen: TPen read FPen write SetPen;
property Shadow: Boolean read FShadow write SetShadow;
property ShadowOffset: Cardinal read FShadowOffset write SetShadowOffset;
property ShadowColor: TColor read FShadowColor write SetShadowColor;
property ShowHint;
property Visible;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
end;

/////////////////////////////////////添加标签/////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////
{ TCustomShapeLabel }
TCustomShapeLabel = class(TCustomShape)
private
{ Private declarations }
FEditLabel: TBoundLabel;
FLabelPosition: TLabelPosition;
FLabelSpacing: Integer;
procedure SetLabelPosition(const Value: TLabelPosition);
procedure SetLabelSpacing(const Value: Integer);
protected
{ Protected declarations }
procedure SetParent(AParent: TWinControl); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetName(const Value: TComponentName); override;
procedure CMVisiblechanged(var Message: TMessage);
message CM_VISIBLECHANGED;
procedure CMEnabledchanged(var Message: TMessage);
message CM_ENABLEDCHANGED;
procedure CMBidimodechanged(var Message: TMessage);
message CM_BIDIMODECHANGED;
public
{ Public declarations }
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer); override;
procedure SetupInternalLabel;
property EditLabel: TBoundLabel read FEditLabel;
property LabelPosition: TLabelPosition read FLabelPosition write SetLabelPosition;
property LabelSpacing: Integer read FLabelSpacing write SetLabelSpacing;
end;


{ TShapeLabel }
TShapeLabel = class(TCustomShapeLabel)
published
property Anchors;
property AutoSize;
property Color;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property EditLabel;
property Enabled;
property Font;
property LabelPosition;
property LabelSpacing;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;

property OnMouseEnter;
property OnMouseLeave;

end;
////////////////////////////////////////////////////////
////////////////////////////////////////////////////////

{ TCustomPolyShape }
TCustomPolyShape = class(TShapeLabel)
protected
function CalcPoly(var Points: Array of TPoint; Source: Array of TPoint; AWidth, AHeight: Integer): Boolean; virtual;
procedure OffsetPoly(var Points: Array of TPoint; OfsX,OfsY: Integer); virtual;
end;

{ TRectShape }
TRectShape = class(TShapeLabel)
protected
procedure PaintShadow; override;
procedure PaintShape; override;
end;

{ TRoundRectShape }
TRoundRectShape = class(TShapeLabel)
protected
procedure PaintShadow; override;
procedure PaintShape; override;
end;

{ TSquareShape }
TSquareShape = class(TShapeLabel)
protected
procedure PaintShadow; override;
procedure PaintShape; override;
end;

{ TRoundSquareShape }
TRoundSquareShape = class(TShapeLabel)
protected
procedure PaintShadow; override;
procedure PaintShape; override;
end;

{ TEllipseShape }
TEllipseShape = class(TShapeLabel)
protected
procedure PaintShadow; override;
procedure PaintShape; override;
end;

{ TCircleShape }
TCircleShape = class(TShapeLabel)
protected
procedure PaintShadow; override;
procedure PaintShape; override;
end;

{ TTriangleShape }
TTriangleShape = class(TCustomPolyShape)
protected
procedure PaintShadow; override;
procedure PaintShape; override;
end;

{ TParallelogramShape }
TParallelogramShape = class(TCustomPolyShape)
protected
procedure PaintShadow; override;
procedure PaintShape; override;
end;

{ TTrapezoidShape }
TTrapezoidShape = class(TCustomPolyShape)
protected
procedure PaintShadow; override;
procedure PaintShape; override;
end;

{ TPentagonShape }
TPentagonShape = class(TCustomPolyShape)
protected
procedure PaintShadow; override;
procedure PaintShape; override;
end;

{ THexagonShape }
THexagonShape = class(TCustomPolyShape)
protected
procedure PaintShadow; override;
procedure PaintShape; override;
end;

{ TOctagonShape }
TOctagonShape = class(TCustomPolyShape)
protected
procedure PaintShadow; override;
procedure PaintShape; override;
end;

{ TStarShape }
TStarShape = class(TCustomPolyShape)
protected
function CalcPoly(var Points: Array of TPoint; Source: Array of TPoint; AWidth, AHeight: Integer): Boolean; override;
procedure PaintShadow; override;
procedure PaintShape; override;
end;

{ TBubbleShape }
TBubbleShape = class(TCustomPolyShape)
protected
function CalcPoly(var Points: Array of TPoint; Source: Array of TPoint; AWidth, AHeight: Integer): Boolean; override;
procedure PaintShadow; override;
procedure PaintShape; override;
end;
////////////////////////添加菱形图形 ,以TParallelogramShape为参考
{ TDiamondShape }
TDiamondShape = class(TCustomPolyShape)

protected
procedure PaintShadow; override;
procedure PaintShape; override;
// FCaption: TLabel;
public
published
end;



procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Shapes', [TRectShape]);
RegisterComponents('Shapes', [TRoundRectShape]);
RegisterComponents('Shapes', [TSquareShape]);
RegisterComponents('Shapes', [TRoundSquareShape]);
RegisterComponents('Shapes', [TEllipseShape]);
RegisterComponents('Shapes', [TCircleShape]);
RegisterComponents('Shapes', [TTriangleShape]);
RegisterComponents('Shapes', [TParallelogramShape]);
RegisterComponents('Shapes', [TTrapezoidShape]);
RegisterComponents('Shapes', [TPentagonShape]);
RegisterComponents('Shapes', [THexagonShape]);
RegisterComponents('Shapes', [TOctagonShape]);
RegisterComponents('Shapes', [TStarShape]);
RegisterComponents('Shapes', [TBubbleShape]);
RegisterComponents('Shapes', [TDiamondShape]);

end;


{ Polygon points for shapes }
const
POLY_TRIANGLE : Array[0..3] of TPoint =
((X:50;Y:0),(X:100;Y:100),(X:0;Y:100),(X:50;Y:0));
POLY_PARALLELOGRAM : Array[0..4] of TPoint =
((X:0;Y:0),(X:75;Y:0),(X:100;Y:100),(X:25;Y:100),(X:0;Y:0));
POLY_TRAPEZOID : Array[0..4] of TPoint =
((X:25;Y:0),(X:75;Y:0),(X:100;Y:100),(X:0;Y:100),(X:25;Y:0));
POLY_PENTAGON : Array[0..5] of TPoint =
((X:50;Y:0),(X:100;Y:50),(X:75;Y:100),(X:25;Y:100),(X:0;Y:50),(X:50;Y:0));
POLY_HEXAGON : Array[0..6] of TPoint =
((X:25;Y:0),(X:75;Y:0),(X:100;Y:50),(X:75;Y:100),(X:25;Y:100),(X:0;Y:50),
(X:25;Y:0));
POLY_OCTAGON : Array[0..8] of TPoint =
((X:25;Y:0),(X:75;Y:0),(X:100;Y:25),(X:100;Y:75),(X:75;Y:100),(X:25;Y:100),
(X:0;Y:75),(X:0;Y:25),(X:25;Y:0));
POLY_STAR : Array[0..16] of TPoint =
((X:11;Y:0),(X:13;Y:6),(X:19;Y:3),(X:16;Y:9),(X:22;Y:11),(X:16;Y:13),
(X:19;Y:19),(X:13;Y:16),(X:11;Y:22),(X:9;Y:16),(X:3;Y:19),(X:6;Y:13),
(X:0;Y:11),(X:6;Y:9),(X:3;Y:3),(X:9;Y:6),(X:11;Y:0));
POLY_BUBBLE : Array[0..11] of TPoint =
((X:10;Y:23),(X:17;Y:10),(X:20;Y:10),(X:23;Y:7),(X:23;Y:3),(X:20;Y:0),
(X:3;Y:0),(X:0;Y:3),(X:0;Y:7),(X:3;Y:10),(X:15;Y:10),(X:10;Y:23));

//////////////////添加菱形坐标点
POLY_DIAMOND : Array[0..4] of TPoint =
((X:0;Y:50),(X:50;Y:0),(X:100;Y:50),(X:50;Y:100),(X:0;Y:50));


{ TCustomShape }
constructor TCustomShape.Create(AOwner: TComponent);
begin
inherited Create(AOwner);

{ Initialize }
ControlStyle := ControlStyle + [csReplicatable];
Width := 65;
Height := 65;

FBrush := TBrush.Create;
FBrush.OnChange := ChangeRedraw;
FPen := TPen.Create;
FPen.OnChange := ChangeRedraw;
FShadow := True;
FShadowOffset := 2;
FShadowColor := clBtnShadow;
end;

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

procedure TCustomShape.Paint;
begin
inherited Paint;

Canvas.Brush := FBrush;
Canvas.Pen := FPen;

if Shadow then PaintShadow;
PaintShape;
end;

procedure TCustomShape.PaintShadow;
begin
Canvas.Brush.Color := FShadowColor;
Canvas.Pen.Color := FShadowColor;
end;

procedure TCustomShape.PaintShape;
begin
Canvas.Brush.Color := FBrush.Color;
Canvas.Pen.Color := FPen.Color;
end;

procedure TCustomShape.ChangeRedraw(Sender: TObject);
begin
Invalidate;
end;

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

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

procedure TCustomShape.SetShadow(Value: Boolean);
begin
if FShadow <> Value then begin
FShadow := Value;
Invalidate;
end;
end;

procedure TCustomShape.SetShadowOffset(Value: Cardinal);
begin
if FShadowOffset <> Value then begin
FShadowOffset := Value;
Invalidate;
end;
end;

procedure TCustomShape.SetShadowColor(Value: TColor);
begin
if FShadowColor <> Value then begin
FShadowColor := Value;
Invalidate;
end;
end;





{ TCustomPolyShape }
function TCustomPolyShape.CalcPoly(var Points: Array of TPoint; Source: Array of TPoint; AWidth, AHeight: Integer): Boolean;
var i : Integer;
lx,ly : LongInt;
begin
Result := True;
try
for i := Low(Points) to High(Points) do begin
lx := MulDiv(Source.x,AWidth,100);
ly := MulDiv(Source.y,AHeight,100);
Points.x := lx;
Points.y := ly;
end;
except
Result := False;
end;
end;

procedure TCustomPolyShape.OffsetPoly(var Points: Array of TPoint; OfsX,OfsY: Integer);
var i: Integer;
begin
for i := Low(Points) to High(Points) do begin
Points.x := Points.x+OfsX;
Points.y := Points.y+OfsY;
end;
end;





{ TRectShape }
procedure TRectShape.PaintShadow;
var rl,rt,rw,rh : Integer;
begin
inherited PaintShadow;

if Shadow then begin
{ Calc width and height of the shadow rectangle }
rl := Pen.Width div 2+ShadowOffset;
rt := Pen.Width div 2+ShadowOffset;

rw := Width-ShadowOffset-Pen.Width+1;
rh := Height-ShadowOffset-Pen.Width+1;

if Pen.Width = 0 then begin
Dec(rw);
Dec(rh);
end;

{ Draw the shadow rectangle }
Canvas.Rectangle(rl,rt,rl+rw,rt+rh);
end;
end;

procedure TRectShape.PaintShape;
var rl,rt,rw,rh : Integer;
begin
inherited PaintShape;

{ Calc the width and height of the rectangle }
rl := Pen.Width div 2;
rt := Pen.Width div 2;

rw := Width-ShadowOffset-Pen.Width+1;
rh := Height-ShadowOffset-Pen.Width+1;

if not Shadow then begin
Inc(rw,ShadowOffset);
Inc(rh,ShadowOffset);
end;

if Pen.Width = 0 then begin
Dec(rw);
Dec(rh);
end;

{ Paint the rectangle }
Canvas.Rectangle(rl,rt,rl+rw,rt+rh);
end;





{ TRoundRectShape }
procedure TRoundRectShape.PaintShadow;
var rl,rt,rw,rh,r : Integer;
begin
inherited PaintShadow;

if Shadow then begin
{ Calc width and height of the shadow rectangle }
rl := Pen.Width div 2+ShadowOffset;
rt := Pen.Width div 2+ShadowOffset;

rw := Width-ShadowOffset-Pen.Width+1;
rh := Height-ShadowOffset-Pen.Width+1;

if Pen.Width = 0 then begin
Dec(rw);
Dec(rh);
end;

if rw < rh then r := rw else r := rh;

{ Draw the shadow rectangle }
Canvas.RoundRect(rl,rt,rl+rw,rt+rh,r div 4,r div 4);
end;
end;

procedure TRoundRectShape.PaintShape;
var rl,rt,rw,rh,r : Integer;
begin
inherited PaintShape;

{ Calc the width and height of the rectangle }
rl := Pen.Width div 2;
rt := Pen.Width div 2;

rw := Width-ShadowOffset-Pen.Width+1;
rh := Height-ShadowOffset-Pen.Width+1;

if not Shadow then begin
Inc(rw,ShadowOffset);
Inc(rh,ShadowOffset);
end;

if Pen.Width = 0 then begin
Dec(rw);
Dec(rh);
end;

if rw < rh then r := rw else r := rh;

{ Paint the rectangle }
Canvas.RoundRect(rl,rt,rl+rw,rt+rh,r div 4,r div 4);
end;





{ TSquareShape }
procedure TSquareShape.PaintShadow;
var rl,rt,rw,rh : Integer;
begin
inherited PaintShadow;

if Shadow then begin
{ Calc width and height of the shadow square }
rl := Pen.Width div 2+ShadowOffset;
rt := Pen.Width div 2+ShadowOffset;

rw := Width-ShadowOffset-Pen.Width+1;
rh := Height-ShadowOffset-Pen.Width+1;

if Pen.Width = 0 then begin
Dec(rw);
Dec(rh);
end;

if rw > rh then
rw := rh
else
rh := rw;

{ Draw the shadow square }
Canvas.Rectangle(rl,rt,rl+rw,rt+rh);
end;
end;

procedure TSquareShape.PaintShape;
var rl,rt,rw,rh: Integer;
begin
inherited PaintShape;

{ Calc the width and height of the square }
rl := Pen.Width div 2;
rt := Pen.Width div 2;

rw := Width-ShadowOffset-Pen.Width+1;
rh := Height-ShadowOffset-Pen.Width+1;

if not Shadow then begin
Inc(rw,ShadowOffset);
Inc(rh,ShadowOffset);
end;

if Pen.Width = 0 then begin
Dec(rw);
Dec(rh);
end;

if rw > rh then
rw := rh
else
rh := rw;

{ Paint the square }
Canvas.Rectangle(rl,rt,rl+rw,rt+rh);
end;





{ TRoundSquareShape }
procedure TRoundSquareShape.PaintShadow;
var rl,rt,rw,rh,r : Integer;
begin
inherited PaintShadow;

if Shadow then begin
{ Calc width and height of the shadow square }
rl := Pen.Width div 2+ShadowOffset;
rt := Pen.Width div 2+ShadowOffset;

rw := Width-ShadowOffset-Pen.Width+1;
rh := Height-ShadowOffset-Pen.Width+1;

if Pen.Width = 0 then begin
Dec(rw);
Dec(rh);
end;

if rw > rh then begin
rw := rh;
r := rh;
end else begin
rh := rw;
r := rw;
end;

{ Draw the shadow square }
Canvas.RoundRect(rl,rt,rl+rw,rt+rh,r div 4,r div 4);
end;
end;

procedure TRoundSquareShape.PaintShape;
var rl,rt,rw,rh,r : Integer;
begin
inherited PaintShape;

{ Calc the width and height of the square }
rl := Pen.Width div 2;
rt := Pen.Width div 2;

rw := Width-ShadowOffset-Pen.Width+1;
rh := Height-ShadowOffset-Pen.Width+1;

if not Shadow then begin
Inc(rw,ShadowOffset);
Inc(rh,ShadowOffset);
end;

if Pen.Width = 0 then begin
Dec(rw);
Dec(rh);
end;

if rw > rh then begin
rw := rh;
r := rh;
end else begin
rh := rw;
r := rw;
end;

{ Paint the square }
Canvas.RoundRect(rl,rt,rl+rw,rt+rh,r div 4,r div 4);
end;





{ TEllipseShape }
procedure TEllipseShape.PaintShadow;
var rl,rt,rw,rh : Integer;
begin
inherited PaintShadow;

if Shadow then begin
{ Calc width and height of the shadow ellipse }
rl := Pen.Width div 2+ShadowOffset;
rt := Pen.Width div 2+ShadowOffset;

rw := Width-ShadowOffset-Pen.Width+1;
rh := Height-ShadowOffset-Pen.Width+1;

if Pen.Width = 0 then begin
Dec(rw);
Dec(rh);
end;

{ Draw the shadow ellipse }
Canvas.Ellipse(rl,rt,rl+rw,rt+rh);
end;
end;

procedure TEllipseShape.PaintShape;
var rl,rt,rw,rh : Integer;
begin
inherited PaintShape;

{ Calc the width and height of the ellipse }
rl := Pen.Width div 2;
rt := Pen.Width div 2;

rw := Width-ShadowOffset-Pen.Width+1;
rh := Height-ShadowOffset-Pen.Width+1;

if not Shadow then begin
Inc(rw,ShadowOffset);
Inc(rh,ShadowOffset);
end;

if Pen.Width = 0 then begin
Dec(rw);
Dec(rh);
end;

{ Paint the ellipse }
Canvas.Ellipse(rl,rt,rl+rw,rt+rh);
end;





{ TCircleShape }
procedure TCircleShape.PaintShadow;
var rl,rt,rw,rh : Integer;
begin
inherited PaintShadow;

if Shadow then begin
{ Calc width and height of the shadow Circle }
rl := Pen.Width div 2+ShadowOffset;
rt := Pen.Width div 2+ShadowOffset;

rw := Width-ShadowOffset-Pen.Width+1;
rh := Height-ShadowOffset-Pen.Width+1;

if Pen.Width = 0 then begin
Dec(rw);
Dec(rh);
end;

if rw > rh then
rw := rh
else
rh := rw;

{ Draw the shadow Circle }
Canvas.Ellipse(rl,rt,rl+rw,rt+rh);
end;
end;

procedure TCircleShape.PaintShape;
var rl,rt,rw,rh: Integer;
begin
inherited PaintShape;

{ Calc the width and height of the Circle }
rl := Pen.Width div 2;
rt := Pen.Width div 2;

rw := Width-ShadowOffset-Pen.Width+1;
rh := Height-ShadowOffset-Pen.Width+1;

if not Shadow then begin
Inc(rw,ShadowOffset);
Inc(rh,ShadowOffset);
end;

if Pen.Width = 0 then begin
Dec(rw);
Dec(rh);
end;

if rw > rh then
rw := rh
else
rh := rw;

{ Paint the Circle }
Canvas.Ellipse(rl,rt,rl+rw,rt+rh);
end;





{ TTriangleShape }
procedure TTriangleShape.PaintShadow;
var Points : Array[0..3] of TPoint;
l,t,w,h : Integer;
begin
inherited PaintShadow;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_TRIANGLE,w,h) then begin
OffsetPoly(Points,l+ShadowOffset,t+ShadowOffset);
Canvas.Polygon(Points);
end;
end;

procedure TTriangleShape.PaintShape;
var Points : Array[0..3] of TPoint;
l,t,w,h : Integer;
begin
inherited PaintShape;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if not Shadow then begin
Inc(w,ShadowOffset);
Inc(h,ShadowOffset);
end;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_TRIANGLE,w,h) then begin
OffsetPoly(Points,l,t);
Canvas.Polygon(Points);
end;
end;





{ TParallelogramShape }
procedure TParallelogramShape.PaintShadow;
var Points : Array[0..4] of TPoint;
l,t,w,h : Integer;
begin
inherited PaintShadow;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_PARALLELOGRAM,w,h) then begin
OffsetPoly(Points,l+ShadowOffset,t+ShadowOffset);
Canvas.Polygon(Points);
end;
end;

procedure TParallelogramShape.PaintShape;
var Points : Array[0..4] of TPoint;
l,t,w,h : Integer;
begin
inherited PaintShape;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if not Shadow then begin
Inc(w,ShadowOffset);
Inc(h,ShadowOffset);
end;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_PARALLELOGRAM,w,h) then begin
OffsetPoly(Points,l,t);
Canvas.Polygon(Points);
end;
end;

//////////////////////////////////////////////////////
////////////////////画菱形///////////////////////////
{ TDiamondShape }
procedure TDiamondShape.PaintShadow;
var Points : Array[0..4] of TPoint;
l,t,w,h : Integer;
begin
inherited PaintShadow;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_DIAMOND,w,h) then begin
OffsetPoly(Points,l+ShadowOffset,t+ShadowOffset);
Canvas.Polygon(Points);
end;
end;

procedure TDiamondShape.PaintShape;
var Points : Array[0..4] of TPoint;
l,t,w,h : Integer;

Flags: Longint;

begin
inherited PaintShape;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if not Shadow then begin
Inc(w,ShadowOffset);
Inc(h,ShadowOffset);
end;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_DIAMOND,w,h) then begin
OffsetPoly(Points,l,t);
Canvas.Polygon(Points);
end;

//////////////////显示Caption
// Flags := DT_EXPANDTABS ;// or DT_VCENTER or Alignments[FAlignment];
// Flags := DrawTextBiDiModeFlags(Flags);
// canvas.TextOut(round(w/2.0),round(h/2.0),caption);
// canvas.DrawText(Handle, PChar(Caption), -1, Rect, Flags);

end;




{ TTrapezoidShape }
procedure TTrapezoidShape.PaintShadow;
var Points : Array[0..4] of TPoint;
l,t,w,h : Integer;
begin
inherited PaintShadow;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_TRAPEZOID,w,h) then begin
OffsetPoly(Points,l+ShadowOffset,t+ShadowOffset);
Canvas.Polygon(Points);
end;
end;

procedure TTrapezoidShape.PaintShape;
var Points : Array[0..4] of TPoint;
l,t,w,h : Integer;
begin
inherited PaintShape;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if not Shadow then begin
Inc(w,ShadowOffset);
Inc(h,ShadowOffset);
end;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_TRAPEZOID,w,h) then begin
OffsetPoly(Points,l,t);
Canvas.Polygon(Points);
end;
end;





{ TPentagonShape }
procedure TPentagonShape.PaintShadow;
var Points : Array[0..5] of TPoint;
l,t,w,h : Integer;
begin
inherited PaintShadow;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_PENTAGON,w,h) then begin
OffsetPoly(Points,l+ShadowOffset,t+ShadowOffset);
Canvas.Polygon(Points);
end;
end;

procedure TPentagonShape.PaintShape;
var Points : Array[0..5] of TPoint;
l,t,w,h : Integer;
begin
inherited PaintShape;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if not Shadow then begin
Inc(w,ShadowOffset);
Inc(h,ShadowOffset);
end;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_PENTAGON,w,h) then begin
OffsetPoly(Points,l,t);
Canvas.Polygon(Points);
end;
end;





{ THexagonShape }
procedure THexagonShape.PaintShadow;
var Points : Array[0..6] of TPoint;
l,t,w,h : Integer;
begin
inherited PaintShadow;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_HEXAGON,w,h) then begin
OffsetPoly(Points,l+ShadowOffset,t+ShadowOffset);
Canvas.Polygon(Points);
end;
end;

procedure THexagonShape.PaintShape;
var Points : Array[0..6] of TPoint;
l,t,w,h : Integer;
begin
inherited PaintShape;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if not Shadow then begin
Inc(w,ShadowOffset);
Inc(h,ShadowOffset);
end;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_HEXAGON,w,h) then begin
OffsetPoly(Points,l,t);
Canvas.Polygon(Points);
end;
end;





{ TOctagonShape }
procedure TOctagonShape.PaintShadow;
var Points : Array[0..8] of TPoint;
l,t,w,h : Integer;
begin
inherited PaintShadow;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_OCTAGON,w,h) then begin
OffsetPoly(Points,l+ShadowOffset,t+ShadowOffset);
Canvas.Polygon(Points);
end;
end;

procedure TOctagonShape.PaintShape;
var Points : Array[0..8] of TPoint;
l,t,w,h : Integer;
begin
inherited PaintShape;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if not Shadow then begin
Inc(w,ShadowOffset);
Inc(h,ShadowOffset);
end;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_OCTAGON,w,h) then begin
OffsetPoly(Points,l,t);
Canvas.Polygon(Points);
end;
end;





{ TStarShape }
function TStarShape.CalcPoly(var Points: Array of TPoint; Source: Array of TPoint; AWidth, AHeight: Integer): Boolean;
var i : Integer;
lx,ly : LongInt;
begin
Result := True;
try
for i := Low(Points) to High(Points) do begin
lx := MulDiv(Source.x,AWidth,22);
ly := MulDiv(Source.y,AHeight,22);
Points.x := lx;
Points.y := ly;
end;
except
Result := False;
end;
end;

procedure TStarShape.PaintShadow;
var Points : Array[0..16] of TPoint;
l,t,w,h : Integer;
begin
inherited PaintShadow;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_STAR,w,h) then begin
OffsetPoly(Points,l+ShadowOffset,t+ShadowOffset);
Canvas.Polygon(Points);
end;
end;

procedure TStarShape.PaintShape;
var Points : Array[0..16] of TPoint;
l,t,w,h : Integer;
begin
inherited PaintShape;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if not Shadow then begin
Inc(w,ShadowOffset);
Inc(h,ShadowOffset);
end;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_STAR,w,h) then begin
OffsetPoly(Points,l,t);
Canvas.Polygon(Points);
end;
end;





{ TBubbleShape }
function TBubbleShape.CalcPoly(var Points: Array of TPoint; Source: Array of TPoint; AWidth, AHeight: Integer): Boolean;
var i : Integer;
lx,ly : LongInt;
begin
Result := True;
try
for i := Low(Points) to High(Points) do begin
lx := MulDiv(Source.x,AWidth,23);
ly := MulDiv(Source.y,AHeight,23);
Points.x := lx;
Points.y := ly;
end;
except
Result := False;
end;
end;

procedure TBubbleShape.PaintShadow;
var Points : Array[0..11] of TPoint;
l,t,w,h : Integer;
begin
inherited PaintShadow;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_BUBBLE,w,h) then begin
OffsetPoly(Points,l+ShadowOffset,t+ShadowOffset);
Canvas.Polygon(Points);
end;
end;

procedure TBubbleShape.PaintShape;
var Points : Array[0..11] of TPoint;
l,t,w,h : Integer;
begin
inherited PaintShape;

{ Calc the new coordinates for the current width and height }
l := Pen.Width div 2;
t := l;
w := Width-ShadowOffset-1-Pen.Width;
h := Height-ShadowOffset-1-Pen.Width;

if not Shadow then begin
Inc(w,ShadowOffset);
Inc(h,ShadowOffset);
end;

if Pen.Width = 0 then begin
Dec(w);
Dec(h);
end;

if CalcPoly(Points,POLY_BUBBLE,w,h) then begin
OffsetPoly(Points,l,t);
Canvas.Polygon(Points);
end;
end;

////////////////////////////////////添加标签///////////////////////////
///////////////////////////////////////////////////////////////////////
{ TBoundLabel }

constructor TBoundLabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Name := 'SubLabel';
SetSubComponent(True);
if Assigned(AOwner) then
Caption := AOwner.Name;
end;

procedure TBoundLabel.AdjustBounds;
begin
inherited AdjustBounds;
if Owner is TCustomShapeLabel then
with Owner as TCustomShapeLabel do
SetLabelPosition(LabelPosition);
end;

function TBoundLabel.GetHeight: Integer;
begin
Result := inherited Height;
end;

function TBoundLabel.GetLeft: Integer;
begin
Result := inherited Left;
end;

function TBoundLabel.GetTop: Integer;
begin
Result := inherited Top;
end;

function TBoundLabel.GetWidth: Integer;
begin
Result := inherited Width;
end;

procedure TBoundLabel.SetHeight(const Value: Integer);
begin
SetBounds(Left, Top, Width, Value);
end;

procedure TBoundLabel.SetWidth(const Value: Integer);
begin
SetBounds(Left, Top, Value, Height);
end;

///////////////////////////////////////////
{ TCustomShapeLabel }

constructor TCustomShapeLabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FLabelPosition := lpCenter;
FLabelSpacing := 3;
SetupInternalLabel;
EditLabel.Transparent:=true;
EditLabel.Font.Size:=9;
EditLabel.WordWrap:=true;
EditLabel.Width:=80;
end;

procedure TCustomShapeLabel.CMBidimodechanged(var Message: TMessage);
begin
inherited;
FEditLabel.BiDiMode := BiDiMode;
end;

procedure TCustomShapeLabel.CMEnabledchanged(var Message: TMessage);
begin
inherited;
FEditLabel.Enabled := Enabled;
end;

procedure TCustomShapeLabel.CMVisiblechanged(var Message: TMessage);
begin
inherited;
FEditLabel.Visible := Visible;
end;

procedure TCustomShapeLabel.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (AComponent = FEditLabel) and (Operation = opRemove) then
FEditLabel := nil;
end;

procedure TCustomShapeLabel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
SetLabelPosition(FLabelPosition);
end;

procedure TCustomShapeLabel.SetLabelPosition(const Value: TLabelPosition);
var
P: TPoint;
begin
if FEditLabel = nil then exit;
FLabelPosition := Value;
case Value of
lpCenter: P := Point(Left+round(width/2)- round((FEditLabel.Width)/2),Top + ((Height - FEditLabel.Height) div 2));

lpAbove : P := Point(Left+round(width/2)- round((FEditLabel.Width)/2), Top - FEditLabel.Height - FLabelSpacing);
lpBelow : P := Point(Left+round(width/2)- round((FEditLabel.Width)/2), Top + Height + FLabelSpacing);
lpLeft : P := Point(Left - FEditLabel.Width - FLabelSpacing,
Top + ((Height - FEditLabel.Height) div 2));
lpRight: P := Point(Left + Width + FLabelSpacing,
Top + ((Height - FEditLabel.Height) div 2));
end;
FEditLabel.SetBounds(P.x, P.y, FEditLabel.Width, FEditLabel.Height);
end;

procedure TCustomShapeLabel.SetLabelSpacing(const Value: Integer);
begin
FLabelSpacing := Value;
SetLabelPosition(FLabelPosition);
end;

procedure TCustomShapeLabel.SetName(const Value: TComponentName);
begin
if (csDesigning in ComponentState) and ((FEditlabel.GetTextLen = 0) or
(CompareText(FEditLabel.Caption, Name) = 0)) then
FEditLabel.Caption := Value;
inherited SetName(Value);
if csDesigning in ComponentState then
Text := '';
end;

procedure TCustomShapeLabel.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
if FEditLabel = nil then exit;
FEditLabel.Parent := AParent;
FEditLabel.Visible := True;
end;

procedure TCustomShapeLabel.SetupInternalLabel;
begin
if Assigned(FEditLabel) then exit;
FEditLabel := TBoundLabel.Create(Self);
FEditLabel.FreeNotification(Self);
// FEditLabel.FocusControl := Self;
end;

////////////////添加鼠标进入事件
//////////////////////
procedure TCustomShape.CMMouseEnter(var Message: TMessage);
begin
inherited;
if Assigned(FOnMouseEnter) then
FOnMouseEnter(Self);
end;

procedure TCustomShape.CMMouseLeave(var Message: TMessage);
begin
inherited;
if Assigned(FOnMouseLeave) then
FOnMouseLeave(Self);
end;

end.