（原创)一个简单的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是间隔。

当时为了一个小项目用，就硬计算各个点的坐标了，要灵活点，可以用映射变换（旋转变换），那就不要硬计算坐标点，并且可以做任意方向。