（原创)一个简单的FMX箭头控件
一个盒子的帖子求箭头控件，我就贴了个我自己用的简单箭头控件，见：http://bbs.2ccc.com/topic.asp?topicid=589754
这里再贴个源码:
unit FMX.JKArrows; interface uses System.SysUtils, System.Classes, System.Types, System.UITypes, FMX.Types, FMX.Controls, FMX.Objects, FMX.Graphics; type TJKArrowDirect = (Up, Right, Down, Left); TJKArrowKind = (FillArrow, SingleArrow, DoubleArrow, DoubleArrowNotTail); TJKArrow = class(TShape) private FArrowKind: TJKArrowKind; FPath: TPathData; FLinePoints: array of TPointF; FTwoLineInterval: Single; FTailLineLongPer: Single; FTailLineInterval: Single; FTailLineWidthPer: Single; FLineOffsetPer: Single; FArrowDirect: TJKArrowDirect; function GetLinePoints: Integer; procedure DrawFillArrow; procedure DrawLineArrow; procedure SetTailLineLongPer(const Value: Single); procedure SetTailLineInterval(const Value: Single); procedure SetTwoLineInterval(const Value: Single); procedure SetTailLineWidthPer(const Value: Single); procedure SetArrowKind(const Value: TJKArrowKind); procedure SetLineOffsetPer(const Value: Single); procedure SetArrowDirect(const Value: TJKArrowDirect); protected procedure CreatePath; procedure ReSize; override; procedure Paint; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Align; property Anchors; property ClipChildren default False; property ClipParent default False; property Cursor default crDefault; property DragMode default TDragMode.dmManual; property EnableDragHighlight default True; property Enabled default True; property Fill; property Locked default False; property Height; property HitTest default True; property Padding; property Opacity; property Margins; property PopupMenu; property Position; property RotationAngle; property RotationCenter; property Scale; property Size; property Stroke; property Visible default True; property Width; property ArrowKind: TJKArrowKind read FArrowKind write SetArrowKind default TJKArrowKind.FillArrow; property ArrowDirect: TJKArrowDirect read FArrowDirect write SetArrowDirect; //FillArrow property TailLineLongPer: Single read FTailLineLongPer write SetTailLineLongPer; property TailLineWidthPer: Single read FTailLineWidthPer write SetTailLineWidthPer; //LineArrow property LineOffsetPer: Single read FLineOffsetPer write SetLineOffsetPer; property TwoLineInterval: Single read FTwoLineInterval write SetTwoLineInterval; property TailLineInterval: Single read FTailLineInterval write SetTailLineInterval; {Drag and Drop events} property OnDragEnter; property OnDragLeave; property OnDragOver; property OnDragDrop; property OnDragEnd; {Mouse events} property OnClick; property OnDblClick; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnMouseWheel; property OnMouseEnter; property OnMouseLeave; property OnPainting; property OnPaint; property OnResize; property OnResized; end; procedure Register; implementation procedure Register; begin RegisterComponents('JkFMXControl', [TJKArrow]); end; { TJKArrow } constructor TJKArrow.Create(AOwner: TComponent); begin inherited; FArrowKind := TJKArrowKind.FillArrow; FPath := TPathData.Create; Width := 100; Height := 100; RotationCenter.X := 0.5; RotationCenter.Y := 0.5; FTailLineLongPer := 0.6; FTailLineWidthPer := 0.2; FLineOffsetPer := 0.4; FTailLineInterval := 0; FTwoLineInterval := 10; end; destructor TJKArrow.Destroy; begin FPath.DisposeOf; inherited; end; function TJKArrow.GetLinePoints: Integer; var aPoint: TPointF; aTailLineLong: Single; aTailLineWidth: Single; aLineOffset: Single; begin case FArrowKind of FillArrow: begin case FArrowDirect of TJKArrowDirect.Up, TJKArrowDirect.Down: begin aTailLineLong := ShapeRect.Height * FTailLineLongPer; aTailLineWidth := ShapeRect.Width * FTailLineWidthPer; end; TJKArrowDirect.Right, TJKArrowDirect.Left: begin aTailLineLong := ShapeRect.Width * FTailLineLongPer; aTailLineWidth := ShapeRect.Height * FTailLineWidthPer; end; // Down: // begin // aTailLineLong := ShapeRect.Height * FTailLineLongPer; // aTailLineWidth := ShapeRect.Width * FTailLineWidthPer; // end; // Left: // begin // aTailLineLong := ShapeRect.Width * FTailLineLongPer; // aTailLineWidth := ShapeRect.Height * FTailLineWidthPer; // end; end; if FTailLineLongPer < 0.15 then begin Result := 3; SetLength(FLinePoints, 3); case FArrowDirect of TJKArrowDirect.Up: begin aPoint.X := ShapeRect.Left; aPoint.Y := ShapeRect.Top + ShapeRect.Height; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width / 2; aPoint.Y := ShapeRect.Top; FLinePoints[1] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := ShapeRect.Top + ShapeRect.Height; FLinePoints[2] := aPoint; end; TJKArrowDirect.Right: begin aPoint.X := ShapeRect.Left; aPoint.Y := ShapeRect.Top; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2; FLinePoints[1] := aPoint; aPoint.X := ShapeRect.Left; aPoint.Y := ShapeRect.Top + ShapeRect.Height; FLinePoints[2] := aPoint; end; TJKArrowDirect.Down: begin aPoint.X := ShapeRect.Left; aPoint.Y := ShapeRect.Top; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := ShapeRect.Top; FLinePoints[1] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width / 2; aPoint.Y := ShapeRect.Top + ShapeRect.Height; FLinePoints[2] := aPoint; end; TJKArrowDirect.Left: begin aPoint.X := ShapeRect.Left; aPoint.Y := ShapeRect.Top+ ShapeRect.Height / 2; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := ShapeRect.Top; FLinePoints[1] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := ShapeRect.Top + ShapeRect.Height; FLinePoints[2] := aPoint; end; end; end else begin Result := 7; SetLength(FLinePoints, 7); case FArrowDirect of TJKArrowDirect.Up: begin aPoint.X := ShapeRect.Left; aPoint.Y := ShapeRect.Top + ShapeRect.Height - aTailLineLong; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width / 2; aPoint.Y := ShapeRect.Top; FLinePoints[1] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := FLinePoints[0].Y; FLinePoints[2] := aPoint; aPoint.X := ShapeRect.Left + (ShapeRect.Width + aTailLineWidth) / 2; aPoint.Y := FLinePoints[2].Y; FLinePoints[3] := aPoint; aPoint.X := FLinePoints[3].X; aPoint.Y := ShapeRect.Top + ShapeRect.Height; FLinePoints[4] := aPoint; aPoint.X := ShapeRect.Left + (ShapeRect.Width - aTailLineWidth) / 2; aPoint.Y := FLinePoints[4].Y; FLinePoints[5] := aPoint; aPoint.X := FLinePoints[5].X; aPoint.Y := FLinePoints[0].Y; FLinePoints[6] := aPoint; end; TJKArrowDirect.Right: begin aPoint.X := ShapeRect.Left + aTailLineLong; aPoint.Y := ShapeRect.Top; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left+ ShapeRect.Width; aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2; FLinePoints[1] := aPoint; aPoint.X := FLinePoints[0].X; aPoint.Y := ShapeRect.Top+ ShapeRect.Height; FLinePoints[2] := aPoint; aPoint.X := FLinePoints[2].X; aPoint.Y := ShapeRect.Top + (ShapeRect.Height + aTailLineWidth) / 2; FLinePoints[3] := aPoint; aPoint.X := ShapeRect.Left; aPoint.Y := FLinePoints[3].Y; FLinePoints[4] := aPoint; aPoint.X := FLinePoints[4].X; aPoint.Y := ShapeRect.Top + (ShapeRect.Height - aTailLineWidth) / 2; FLinePoints[5] := aPoint; aPoint.X := FLinePoints[0].X; aPoint.Y := FLinePoints[5].Y; FLinePoints[6] := aPoint; end; TJKArrowDirect.Down: begin aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := ShapeRect.Top + aTailLineLong; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width / 2; aPoint.Y := ShapeRect.Top + ShapeRect.Height; FLinePoints[1] := aPoint; aPoint.X := ShapeRect.Left; aPoint.Y := FLinePoints[0].Y; FLinePoints[2] := aPoint; aPoint.X := ShapeRect.Left + (ShapeRect.Width - aTailLineWidth) / 2; aPoint.Y := FLinePoints[2].Y; FLinePoints[3] := aPoint; aPoint.X := FLinePoints[3].X; aPoint.Y := ShapeRect.Top; FLinePoints[4] := aPoint; aPoint.X := ShapeRect.Left + (ShapeRect.Width + aTailLineWidth) / 2; aPoint.Y := FLinePoints[4].Y; FLinePoints[5] := aPoint; aPoint.X := FLinePoints[5].X; aPoint.Y := FLinePoints[0].Y; FLinePoints[6] := aPoint; end; TJKArrowDirect.Left: begin aPoint.X := ShapeRect.Left + ShapeRect.Width - aTailLineLong; aPoint.Y := ShapeRect.Top + ShapeRect.Height; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left; aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2; FLinePoints[1] := aPoint; aPoint.X := FLinePoints[0].X; aPoint.Y := ShapeRect.Top; FLinePoints[2] := aPoint; aPoint.X := FLinePoints[2].X; aPoint.Y := ShapeRect.Top + (ShapeRect.Height - aTailLineWidth) / 2; FLinePoints[3] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := FLinePoints[3].Y; FLinePoints[4] := aPoint; aPoint.X := FLinePoints[4].X; aPoint.Y := ShapeRect.Top + (ShapeRect.Height + aTailLineWidth) / 2; FLinePoints[5] := aPoint; aPoint.X := FLinePoints[0].X; aPoint.Y := FLinePoints[5].Y; FLinePoints[6] := aPoint; end; end; end; end; SingleArrow: begin Result := 6; SetLength(FLinePoints, 6); case FArrowDirect of TJKArrowDirect.Up: begin aLineOffset := ShapeRect.Height * FLineOffsetPer; aPoint.X := ShapeRect.Left; aPoint.Y := ShapeRect.Top + aLineOffset; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width / 2; aPoint.Y := ShapeRect.Top; FLinePoints[1] := aPoint; FLinePoints[2] := FLinePoints[1]; aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := FLinePoints[0].Y; FLinePoints[3] := aPoint; FLinePoints[4].X := FLinePoints[1].X; FLinePoints[4].Y := FLinePoints[1].Y + FTailLineInterval; aPoint.X := FLinePoints[4].X; aPoint.Y := ShapeRect.Top + ShapeRect.Height; FLinePoints[5] := aPoint; end; TJKArrowDirect.Right: begin aLineOffset := ShapeRect.Width * FLineOffsetPer; aPoint.X := ShapeRect.Left + ShapeRect.Width - aLineOffset; aPoint.Y := ShapeRect.Top; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2; FLinePoints[1] := aPoint; FLinePoints[2] := FLinePoints[1]; aPoint.X := FLinePoints[0].X; aPoint.Y := ShapeRect.Top + ShapeRect.Height; FLinePoints[3] := aPoint; FLinePoints[4].X := FLinePoints[1].X - FTailLineInterval; FLinePoints[4].Y := FLinePoints[1].Y; aPoint.X := ShapeRect.Left; aPoint.Y := FLinePoints[4].Y; FLinePoints[5] := aPoint; end; TJKArrowDirect.Down: begin aLineOffset := ShapeRect.Height * FLineOffsetPer; aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := ShapeRect.Top + ShapeRect.Height - aLineOffset; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width / 2; aPoint.Y := ShapeRect.Top + ShapeRect.Height; FLinePoints[1] := aPoint; FLinePoints[2] := FLinePoints[1]; aPoint.X := ShapeRect.Left; aPoint.Y := FLinePoints[0].Y; FLinePoints[3] := aPoint; FLinePoints[4].X := FLinePoints[1].X; FLinePoints[4].Y := FLinePoints[1].Y - FTailLineInterval; aPoint.X := FLinePoints[4].X; aPoint.Y := ShapeRect.Top; FLinePoints[5] := aPoint; end; TJKArrowDirect.Left: begin aLineOffset := ShapeRect.Width * FLineOffsetPer; aPoint.X := ShapeRect.Left + aLineOffset; aPoint.Y := ShapeRect.Top + ShapeRect.Height; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left; aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2; FLinePoints[1] := aPoint; FLinePoints[2] := FLinePoints[1]; aPoint.X := FLinePoints[0].X; aPoint.Y := ShapeRect.Top; FLinePoints[3] := aPoint; FLinePoints[4].X := FLinePoints[1].X + FTailLineInterval; FLinePoints[4].Y := FLinePoints[1].Y; aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := FLinePoints[4].Y; FLinePoints[5] := aPoint; end; end; end; DoubleArrow: begin Result := 10; SetLength(FLinePoints, 10); case FArrowDirect of TJKArrowDirect.Up: begin aLineOffset := ShapeRect.Height * FLineOffsetPer; aPoint.X := ShapeRect.Left; aPoint.Y := ShapeRect.Top + aLineOffset; if aPoint.Y > ShapeRect.Height - FTwoLineInterval then aPoint.Y := ShapeRect.Height - FTwoLineInterval; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width / 2; aPoint.Y := ShapeRect.Top; FLinePoints[1] := aPoint; FLinePoints[2] := FLinePoints[1]; aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := FLinePoints[0].Y; FLinePoints[3] := aPoint; FLinePoints[4].X := FLinePoints[0].X; FLinePoints[4].Y := FLinePoints[0].Y + FTwoLineInterval; FLinePoints[5].X := FLinePoints[1].X; FLinePoints[5].Y := FLinePoints[1].Y + FTwoLineInterval; FLinePoints[6] := FLinePoints[5]; FLinePoints[7].X := FLinePoints[3].X; FLinePoints[7].Y := FLinePoints[3].Y + FTwoLineInterval; FLinePoints[8].X := FLinePoints[5].X; FLinePoints[8].Y := FLinePoints[5].Y + FTailLineInterval; FLinePoints[9].X := FLinePoints[8].X; FLinePoints[9].Y := ShapeRect.Top + ShapeRect.Height; end; TJKArrowDirect.Right: begin aLineOffset := ShapeRect.Width * FLineOffsetPer; aPoint.X := ShapeRect.Left + ShapeRect.Width - aLineOffset; aPoint.Y := ShapeRect.Top; if aPoint.X < ShapeRect.Left + FTwoLineInterval then aPoint.X := ShapeRect.Left + FTwoLineInterval; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2; FLinePoints[1] := aPoint; FLinePoints[2] := FLinePoints[1]; aPoint.X := FLinePoints[0].X; aPoint.Y := ShapeRect.Top + ShapeRect.Height; FLinePoints[3] := aPoint; FLinePoints[4].X := FLinePoints[0].X - FTwoLineInterval; FLinePoints[4].Y := FLinePoints[0].Y; FLinePoints[5].X := FLinePoints[1].X - FTwoLineInterval; FLinePoints[5].Y := FLinePoints[1].Y; FLinePoints[6] := FLinePoints[5]; FLinePoints[7].X := FLinePoints[3].X - FTwoLineInterval; FLinePoints[7].Y := FLinePoints[3].Y; FLinePoints[8].X := FLinePoints[5].X - FTailLineInterval; FLinePoints[8].Y := FLinePoints[5].Y; FLinePoints[9].X := ShapeRect.Left; FLinePoints[9].Y := FLinePoints[8].Y ; end; TJKArrowDirect.Down: begin aLineOffset := ShapeRect.Height * FLineOffsetPer; aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := ShapeRect.Top + ShapeRect.Height - aLineOffset; if aPoint.Y < ShapeRect.Top + FTwoLineInterval then aPoint.Y := ShapeRect.Top + FTwoLineInterval; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width / 2; aPoint.Y := ShapeRect.Top + ShapeRect.Height; FLinePoints[1] := aPoint; FLinePoints[2] := FLinePoints[1]; aPoint.X := ShapeRect.Left; aPoint.Y := FLinePoints[0].Y; FLinePoints[3] := aPoint; FLinePoints[4].X := FLinePoints[0].X; FLinePoints[4].Y := FLinePoints[0].Y - FTwoLineInterval; FLinePoints[5].X := FLinePoints[1].X; FLinePoints[5].Y := FLinePoints[1].Y - FTwoLineInterval; FLinePoints[6] := FLinePoints[5]; FLinePoints[7].X := FLinePoints[3].X; FLinePoints[7].Y := FLinePoints[3].Y - FTwoLineInterval; FLinePoints[8].X := FLinePoints[5].X; FLinePoints[8].Y := FLinePoints[5].Y - FTailLineInterval; FLinePoints[9].X := FLinePoints[8].X; FLinePoints[9].Y := ShapeRect.Top; end; TJKArrowDirect.Left: begin aLineOffset := ShapeRect.Width * FLineOffsetPer; aPoint.X := ShapeRect.Left + aLineOffset; aPoint.Y := ShapeRect.Top + ShapeRect.Height; if aPoint.X > ShapeRect.Width - FTwoLineInterval then aPoint.X := ShapeRect.Width - FTwoLineInterval; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left; aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2; FLinePoints[1] := aPoint; FLinePoints[2] := FLinePoints[1]; aPoint.X := FLinePoints[0].X; aPoint.Y := ShapeRect.Top; FLinePoints[3] := aPoint; FLinePoints[4].X := FLinePoints[0].X + FTwoLineInterval; FLinePoints[4].Y := FLinePoints[0].Y; FLinePoints[5].X := FLinePoints[1].X + FTwoLineInterval; FLinePoints[5].Y := FLinePoints[1].Y; FLinePoints[6] := FLinePoints[5]; FLinePoints[7].X := FLinePoints[3].X + FTwoLineInterval; FLinePoints[7].Y := FLinePoints[3].Y; FLinePoints[8].X := FLinePoints[5].X + FTailLineInterval; FLinePoints[8].Y := FLinePoints[5].Y; FLinePoints[9].X := ShapeRect.Left + ShapeRect.Width; FLinePoints[9].Y := FLinePoints[8].Y ; end; end; end; DoubleArrowNotTail: begin Result := 8; SetLength(FLinePoints, 8); case FArrowDirect of TJKArrowDirect.Up: begin aLineOffset := ShapeRect.Height * FLineOffsetPer; aPoint.X := ShapeRect.Left; aPoint.Y := ShapeRect.Top + aLineOffset; if aPoint.Y > ShapeRect.Height - FTwoLineInterval then aPoint.Y := ShapeRect.Height - FTwoLineInterval; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width / 2; aPoint.Y := ShapeRect.Top; FLinePoints[1] := aPoint; FLinePoints[2] := FLinePoints[1]; aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := FLinePoints[0].Y; FLinePoints[3] := aPoint; FLinePoints[4].X := FLinePoints[0].X; FLinePoints[4].Y := FLinePoints[0].Y + FTwoLineInterval; FLinePoints[5].X := FLinePoints[1].X; FLinePoints[5].Y := FLinePoints[1].Y + FTwoLineInterval; FLinePoints[6] := FLinePoints[5]; FLinePoints[7].X := FLinePoints[3].X; FLinePoints[7].Y := FLinePoints[3].Y + FTwoLineInterval; end; TJKArrowDirect.Right: begin aLineOffset := ShapeRect.Width * FLineOffsetPer; aPoint.X := ShapeRect.Left + ShapeRect.Width - aLineOffset; aPoint.Y := ShapeRect.Top; if aPoint.X < ShapeRect.Left + FTwoLineInterval then aPoint.X := ShapeRect.Left + FTwoLineInterval; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2; FLinePoints[1] := aPoint; FLinePoints[2] := FLinePoints[1]; aPoint.X := FLinePoints[0].X; aPoint.Y := ShapeRect.Top + ShapeRect.Height; FLinePoints[3] := aPoint; FLinePoints[4].X := FLinePoints[0].X - FTwoLineInterval; FLinePoints[4].Y := FLinePoints[0].Y; FLinePoints[5].X := FLinePoints[1].X - FTwoLineInterval; FLinePoints[5].Y := FLinePoints[1].Y; FLinePoints[6] := FLinePoints[5]; FLinePoints[7].X := FLinePoints[3].X - FTwoLineInterval; FLinePoints[7].Y := FLinePoints[3].Y; end; TJKArrowDirect.Down: begin aLineOffset := ShapeRect.Height * FLineOffsetPer; aPoint.X := ShapeRect.Left + ShapeRect.Width; aPoint.Y := ShapeRect.Top + ShapeRect.Height - aLineOffset; if aPoint.Y < ShapeRect.Top + FTwoLineInterval then aPoint.Y := ShapeRect.Top + FTwoLineInterval; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left + ShapeRect.Width / 2; aPoint.Y := ShapeRect.Top + ShapeRect.Height; FLinePoints[1] := aPoint; FLinePoints[2] := FLinePoints[1]; aPoint.X := ShapeRect.Left; aPoint.Y := FLinePoints[0].Y; FLinePoints[3] := aPoint; FLinePoints[4].X := FLinePoints[0].X; FLinePoints[4].Y := FLinePoints[0].Y - FTwoLineInterval; FLinePoints[5].X := FLinePoints[1].X; FLinePoints[5].Y := FLinePoints[1].Y - FTwoLineInterval; FLinePoints[6] := FLinePoints[5]; FLinePoints[7].X := FLinePoints[3].X; FLinePoints[7].Y := FLinePoints[3].Y - FTwoLineInterval; end; TJKArrowDirect.Left: begin aLineOffset := ShapeRect.Width * FLineOffsetPer; aPoint.X := ShapeRect.Left + aLineOffset; aPoint.Y := ShapeRect.Top + ShapeRect.Height; if aPoint.X > ShapeRect.Width - FTwoLineInterval then aPoint.X := ShapeRect.Width - FTwoLineInterval; FLinePoints[0] := aPoint; aPoint.X := ShapeRect.Left; aPoint.Y := ShapeRect.Top + ShapeRect.Height / 2; FLinePoints[1] := aPoint; FLinePoints[2] := FLinePoints[1]; aPoint.X := FLinePoints[0].X; aPoint.Y := ShapeRect.Top; FLinePoints[3] := aPoint; FLinePoints[4].X := FLinePoints[0].X + FTwoLineInterval; FLinePoints[4].Y := FLinePoints[0].Y; FLinePoints[5].X := FLinePoints[1].X + FTwoLineInterval; FLinePoints[5].Y := FLinePoints[1].Y; FLinePoints[6] := FLinePoints[5]; FLinePoints[7].X := FLinePoints[3].X + FTwoLineInterval; FLinePoints[7].Y := FLinePoints[3].Y; end; end; end; end; end; procedure TJKArrow.CreatePath; var i: Integer; aPointCount: Integer; begin FPath.Clear; aPointCount := GetLinePoints; FPath.MoveTo(FLinePoints[0]); for i := 1 to aPointCount - 1 do FPath.LineTo(FLinePoints[i]); FPath.ClosePath; end; procedure TJKArrow.DrawFillArrow; begin CreatePath; Canvas.FillPath(FPath, Opacity, Fill); Canvas.DrawPath(FPath, Opacity, Stroke); end; procedure TJKArrow.DrawLineArrow; var i: Integer; aLineCount: Integer; begin aLineCount := GetLinePoints div 2; for i := 0 to aLineCount - 1 do Canvas.DrawLine(FLinePoints[i*2], FLinePoints[i*2+1], Opacity, Stroke); end; procedure TJKArrow.Paint; begin inherited; if FArrowKind = TJKArrowKind.FillArrow then begin DrawFillArrow; end else begin DrawLineArrow; end; end; procedure TJKArrow.ReSize; begin inherited; end; procedure TJKArrow.SetArrowDirect(const Value: TJKArrowDirect); begin if FArrowDirect <> Value then begin FArrowDirect := Value; Repaint; end; end; procedure TJKArrow.SetArrowKind(const Value: TJKArrowKind); begin if FArrowKind <> Value then begin FArrowKind := Value; Repaint; end; end; procedure TJKArrow.SetTailLineLongPer(const Value: Single); var aNewValue: Single; begin if FArrowKind <> TJKArrowKind.FillArrow then Exit; aNewValue := Value; if Value > 0.8 then aNewValue := 0.8; if Value < 0.1 then aNewValue := 0; if FTailLineLongPer <> aNewValue then begin FTailLineLongPer := aNewValue; Repaint; end; end; procedure TJKArrow.SetTailLineWidthPer(const Value: Single); var aNewValue: Single; begin if FArrowKind <> TJKArrowKind.FillArrow then Exit; aNewValue := Value; if Value > 0.8 then aNewValue := 0.8; if Value < 0.1 then aNewValue := 0.1; if FTailLineWidthPer <> aNewValue then begin FTailLineWidthPer := aNewValue; Repaint; end; end; procedure TJKArrow.SetLineOffsetPer(const Value: Single); var aNewValue: Single; begin if FArrowKind = TJKArrowKind.FillArrow then Exit; aNewValue := Value; if Value > 0.8 then aNewValue := 0.8; if Value < 0.2 then aNewValue := 0.2; if FLineOffsetPer <> aNewValue then begin FLineOffsetPer := aNewValue; Repaint; end; end; procedure TJKArrow.SetTailLineInterval(const Value: Single); var aNewValue: Single; begin if FArrowKind = TJKArrowKind.FillArrow then Exit; aNewValue := Value; if aNewValue > ShapeRect.Height * 0.2 then aNewValue := ShapeRect.Height * 0.2; if aNewValue < 0 then aNewValue := 0; if FTailLineInterval <> aNewValue then begin FTailLineInterval := aNewValue; Repaint; end; end; procedure TJKArrow.SetTwoLineInterval(const Value: Single); var aNewValue: Single; begin if FArrowKind = TJKArrowKind.FillArrow then Exit; aNewValue := Value; if aNewValue > ShapeRect.Height * 0.25 then aNewValue := ShapeRect.Height * 0.25; if aNewValue < 5 then aNewValue := 5; if FTwoLineInterval <> aNewValue then begin FTwoLineInterval := aNewValue; Repaint; end; end; end.
这个只支持4个方向（上下左右），支持双箭头，线或填充。后缀"Per"的属性是百分比，Val是间隔。
当时为了一个小项目用，就硬计算各个点的坐标了，要灵活点，可以用映射变换（旋转变换），那就不要硬计算坐标点，并且可以做任意方向。
