Delphi指针样式控件代码

最新推荐文章于 2023-12-19 23:45:53 发布
最新推荐文章于 2023-12-19 23:45:53 发布
阅读量295 收藏 1
点赞数
分类专栏： Delphi 文章标签： Delphi 指针样式 控件代码 源码
泰山老父神枕传承人战小东
本文链接：https://blog.csdn.net/xyzhan/article/details/109708677
版权

郑重感谢：本文代码来自Delphi盒子用户janker (janker)，谢谢janker (janker)对Delphi社区做出的奉献！欢迎加入Delphi开发局QQ群:32422310  Delphi控件源码下载网站 

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.

 

战石电子
关注
  • 0
    点赞
  • 踩
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
专栏目录
如何在delphi 中画带箭头的直线（改自网上一位论坛版主的vb代码）
Peter Wu
12-03 2624
procedure TLineItem.Draw(aCanvas: TCanvas);var  Xa, Ya, Xb, Yb: real;  D: real;  X1, Y1, X0, Y0: Integer;begin  aCanvas.Pen.Style := PsSolid;  aCanvas.Pen.Color := clWhite;//画直线  aCa
Delphi代码的标准风格
sailerbai的专栏
12-28 1185
Object Pascal Style Guide - By Charles Calvert(对象Pascal编码风格向导 - 译：Tommy Tong)    我们承认许多好的已经确定的工作室或个人，拥有他们自己的和本文里所说的不同的编程习惯， 但是，我们强烈建议你使用一个工具将你的代码转换为Borland风格的代码，然后再提交给Borland，Project JEDI或其他任何公开的源代码知识
Delphi for iOS开发指南(序):Delphi iOS应用程序开发
DelphiTeacher的专栏
05-14 7404
Delphi for iOS开发指南(序):Delphi iOS应用程序开发   这一系列教程让你使用RAD Studio来开发iOS应用程序： 在最初的配置教程之后，每个教程都为你展示如何使用FireMonkey Tools来创建iOS应用程序。这些教程演示了使用一些重要的FireMonkey组件在你的iOS应用程序中来实现原生风格界面。   准备
控件指针 与数字
ksrsoft的专栏
05-14 867
  Edit1->Text = (int)(void*)cds1;  DataSource1->DataSet = (TDataSet*)(void*) Edit1->Text.ToInt();
【delphi11】delphi基础探索【三、基础组件和事件】
最新发布
Bobowen的博客
12-19 1772
事件和事件处理器 1. 事件 定义：在 Delphi 中，事件是指在程序运行时发生的某种情况，通常由用户操作（如点击、键入）或程序逻辑（如时间到达）触发。 组件事件：几乎所有的 VCL 组件都有事件，如 、、 等。 2. 事件处理器 定义：事件处理器是响应特定事件的过程或函数。它定义了当事件发生时应执行的操作。 创建方式：在设计视图中双击一个组件可自动生成事件处理器的框架代码。 创建和使用事件处理器 步骤 1：选择组件和事件 选择你想要响应的事件类型。例如，如果你想在用户点
delphi 控件大全（确实很全）
fangyuan621的专栏
03-08 5157
delphi控件查询：Torry's Delphi Pages http://www.jrsoftware.org Tb97 最有名的工具条(ToolBar)控件库,仿Office97，如TDoCk97,TToolBar97,TEdit97,TToolWindow97等.http://www.fltvu.com/jiaocheng/chenxu1/delphi/vCl/index.htmhttp://www.delphiarea.com/produCts/http://neftali.clubdel.
Delphi控件开发基础篇
qq_35803640的博客
04-16 1960
Delphi控件开发基础篇 Delphi中控件(Component)是依托于 VCL(Visual Component Library)框架而出的。其根类是TComponent。 大凡控件都是从如下几个类继承得来。 TGraphicControl 在实际的界面开发工作中，有许多简单的控件，其本身仅仅是简单的显示一些提示信息，不会完成什么复杂的工作，譬如 TLabel，TPaintBox等控件；...
delphi 窗体上画任意方向带箭头的直线全套源码
10-01
delphi 窗体上画任意方向带箭头的直线全套源码，程序启动后在主窗体直接用鼠标左键拖动可画出任意方向的带箭头的直线。
一个画流程图的Delphi控件 v2.90
08-10
delphi编写的一个画流程图的工具,目前最新版本是2.90.这是个带全部源码的可视化Delphi控件，可以很方便地添加很多另外的图元。
Android方向传感器实践——自己动手做指南针
easyer2012的专栏
10-23 5676
传感器（Sensor）系统可以让智能手机的功能更加丰富多彩，在Android系统中支持多种传感器。Android的Sensor系统涉及了Android的各个层次。   Android系统支持多种传感器，有的传感器已经在Android的框架中使用，大多数传感器由应用程序来使用。   Android传感器类型分为加速度、磁场、方向、光线、临近性、温度等，具体的如下表：  
Delphi万能指针应用
04-29 1590
今有一函数:function TComm.WriteCommData( pDataToWrite: PChar; dwSizeofDataToWrite: Word ): Boolean; 也就是PComm控件发送数据用的,现在要把buf:array[0..1024]of byte 中的内容发送出去用: comm.WriteCommData(@buf,Len);Len是要发送的
Delphi中的类和对象
blazingfire的专栏
11-21 1026
                   谈谈Delphi中的类和对象1.登不了大雅之堂地理解几个概念   说到类和对象，我们不能不提及这样几个概念：类，对象，实例。就我个人觉得可以这样来理解：对象指的是泛称，自然界的任何实体都可以看成一个对象；而类则是以这些对象某些特征而分成的一系列的种类；实例则是特指属于某一个类的一个对象。好啦，这些大道理我就不用多说了。不如来一个“背道而驰”的作法，我们用Del
Delphi下使用指针的简单总结
weixin_34186950的博客
10-07 212
由于最近公司太忙，好久没有更新我的BLOG了。原来想着写写关于HOOK驱动的文章，可是最后想想好久已经没有做驱动的东西了，怕写出来有错误，于是作罢。开发游戏也有一段时间了，发现使用DELPHI来开发网络游戏不了解DELPHI下指针的使用是完全不行的。所以今天我简单总结以下我使用DELPHI指针的心得。希望对大家有所帮助。 记得在大学学习C语言的时候在谭浩强编写的书中，关于指针一章的开始就说“指针...
Delphi的指针
zp19860529的博客
02-23 2227
Pointers are like jumps, leading wildly from one part of the data structure to another. Their introduction into high-level languages has been a step backwards from which we may never recover.— Anthony Hoare 对指针可能有最让人误解和惧怕的数据类型,因此很多程序员喜欢躲避他们. 但是指针很重要.即使..
在Delphi中使用指针参数
zdk的专栏
02-20 1786
在c语言中用function (int ^par)很方便，查过好多资料没找到Delphi的用法，今晚没事突然想起用Delphi万能指针Pointer（无类型指针）应该可以代替。测试一下通过。procedure xx(a:pchar);var  tm:^TAdodataset;begin  tm:=Pointer(a);...end;procedure bb;var  tm:TAdodatase
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值