Changeset 494 for GraphicTest/Packages/bgrabitmap/bgraarrow.pas

Timestamp:

Dec 22, 2016, 8:49:19 PM (8 years ago)

Author:

chronos

Message:

• Modified: Updated BGRABitmap package.

File:

• GraphicTest/Packages/bgrabitmap/bgraarrow.pas (modified) (6 diffs)

GraphicTest/Packages/bgrabitmap/bgraarrow.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, BGRABitmapTypes, Graphics;
+  Classes, SysUtils, BGRABitmapTypes, BGRAGraphics;
 
 type
-
   { TBGRAArrow }
 
-  TBGRAArrow = class
+  TBGRAArrow = class(TBGRACustomArrow)
   private
     FLineCap: TPenEndCap;
@@ -38 +37 @@
         ATipStyle: TPenJoinStyle; ALineCap: TPenEndCap; const AWidth: single; AOffsetX: single;
         ARepeatCount: integer; ARelativePenWidth: single; ATriangleBackOffset: single): ArrayOfTPointF;
-    function GetIsEndDefined: boolean;
-    function GetIsStartDefined: boolean;
-    procedure SetEndOffsetX(AValue: single);
-    procedure SetEndRepeatCount(AValue: integer);
-    procedure SetEndSizeFactor(AValue: TPointF);
-    procedure SetLineCap(AValue: TPenEndCap);
-    procedure SetStartOffsetX(AValue: single);
-    procedure SetStartRepeatCount(AValue: integer);
-    procedure SetStartSizeFactor(AValue: TPointF);
     procedure SetWidth(AValue: single);
+  protected
+    function GetEndRepeatCount: integer; override;
+    function GetEndSizeFactor: TPointF; override;
+    function GetIsEndDefined: boolean; override;
+    function GetIsStartDefined: boolean; override;
+    function GetEndOffsetX: single; override;
+    function GetStartOffsetX: single; override;
+    function GetStartRepeatCount: integer; override;
+    function GetStartSizeFactor: TPointF; override;
+    procedure SetEndOffsetX(AValue: single); override;
+    procedure SetEndRepeatCount(AValue: integer); override;
+    procedure SetEndSizeFactor(AValue: TPointF); override;
+    procedure SetStartOffsetX(AValue: single); override;
+    procedure SetStartRepeatCount(AValue: integer); override;
+    procedure SetStartSizeFactor(AValue: TPointF); override;
+    function GetLineCap: TPenEndCap; override;
+    procedure SetLineCap(AValue: TPenEndCap); override;
+    procedure SetStart(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle = pjsMiter; ARelativePenWidth: single = 1; ATriangleBackOffset: single = 0);
+    procedure SetEnd(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle = pjsMiter; ARelativePenWidth: single = 1; ATriangleBackOffset: single = 0);
   public
     constructor Create;
-    procedure SetStart(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle;
-        ARelativePenWidth: single; ATriangleBackOffset: single);
-    procedure SetEnd(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle;
-        ARelativePenWidth: single; ATriangleBackOffset: single);
-    function ComputeStartAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF;
-    function ComputeEndAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF;
-    property IsStartDefined: boolean read GetIsStartDefined;
-    property IsEndDefined: boolean read GetIsEndDefined;
-    property LineCap: TPenEndCap read FLineCap write SetLineCap;
-    property StartSize: TPointF read FStartSizeFactor write SetStartSizeFactor;
-    property EndSize: TPointF read FEndSizeFactor write SetEndSizeFactor;
-    property StartOffsetX: single read FStartOffsetX write SetStartOffsetX;
-    property EndOffsetX: single read FEndOffsetX write SetEndOffsetX;
-    property StartRepeatCount: integer read FStartRepeatCount write SetStartRepeatCount;
-    property EndRepeatCount: integer read FEndRepeatCount write SetEndRepeatCount;
+    procedure StartAsNone; override;
+    procedure StartAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override;
+    procedure StartAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override;
+    procedure StartAsTail; override;
+    procedure EndAsNone; override;
+    procedure EndAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override;
+    procedure EndAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override;
+    procedure EndAsTail; override;
+    function ComputeStartAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF; override;
+    function ComputeEndAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF; override;
+
   end;
 
@@ -258 +263 @@
 end;
 
+function TBGRAArrow.GetEndOffsetX: single;
+begin
+  result := FEndOffsetX;
+end;
+
+function TBGRAArrow.GetStartOffsetX: single;
+begin
+  result := FStartOffsetX;
+end;
+
+function TBGRAArrow.GetStartRepeatCount: integer;
+begin
+  result := FStartRepeatCount;
+end;
+
+function TBGRAArrow.GetStartSizeFactor: TPointF;
+begin
+  result := FStartSizeFactor;
+end;
+
 procedure TBGRAArrow.SetEndOffsetX(AValue: single);
 begin
@@ -264 +289 @@
   FEndComputed:= false;
   FEnd := nil;
+end;
+
+function TBGRAArrow.GetLineCap: TPenEndCap;
+begin
+  result := FLineCap;
 end;
 
@@ -324 +354 @@
 end;
 
+function TBGRAArrow.GetEndRepeatCount: integer;
+begin
+  Result:= FEndRepeatCount;
+end;
+
+function TBGRAArrow.GetEndSizeFactor: TPointF;
+begin
+  Result:= FEndSizeFactor;
+end;
+
 constructor TBGRAArrow.Create;
 begin
@@ -329 +369 @@
   FStartSizeFactor := PointF(2,2);
   FEndSizeFactor := PointF(2,2);
+end;
+
+procedure TBGRAArrow.StartAsNone;
+begin
+  SetStart(asNone);
+end;
+
+procedure TBGRAArrow.StartAsClassic(AFlipped: boolean; ACut: boolean;
+  ARelativePenWidth: single);
+var join: TPenJoinStyle;
+begin
+  if (LineCap = pecRound) and not ACut then join := pjsRound else join := pjsMiter;
+  if ACut then
+  begin
+    if AFlipped then
+      SetStart(asFlippedCut,join,ARelativePenWidth)
+    else
+      SetStart(asCut,join,ARelativePenWidth)
+  end
+  else
+  begin
+    if AFlipped then
+      SetStart(asFlipped,join,ARelativePenWidth)
+    else
+      SetStart(asNormal,join,ARelativePenWidth)
+  end;
+end;
+
+procedure TBGRAArrow.StartAsTriangle(ABackOffset: single; ARounded: boolean;
+  AHollow: boolean; AHollowPenWidth: single);
+var join: TPenJoinStyle;
+begin
+  if ARounded then join := pjsRound else join := pjsMiter;
+  if AHollow then
+    SetStart(asHollowTriangle, join,AHollowPenWidth, ABackOffset)
+  else
+    SetStart(asTriangle, join,1,ABackOffset);
+end;
+
+procedure TBGRAArrow.StartAsTail;
+begin
+  SetStart(asTail);
+end;
+
+procedure TBGRAArrow.EndAsNone;
+begin
+  SetEnd(asNone);
+end;
+
+procedure TBGRAArrow.EndAsClassic(AFlipped: boolean; ACut: boolean;
+  ARelativePenWidth: single);
+var join: TPenJoinStyle;
+begin
+  if (LineCap = pecRound) and not ACut then join := pjsRound else join := pjsMiter;
+  if ACut then
+  begin
+    if AFlipped then
+      SetEnd(asFlippedCut,join,ARelativePenWidth)
+    else
+      SetEnd(asCut,join,ARelativePenWidth)
+  end
+  else
+  begin
+    if AFlipped then
+      SetEnd(asFlipped,join,ARelativePenWidth)
+    else
+      SetEnd(asNormal,join,ARelativePenWidth)
+  end;
+end;
+
+procedure TBGRAArrow.EndAsTriangle(ABackOffset: single; ARounded: boolean;
+  AHollow: boolean; AHollowPenWidth: single);
+var join: TPenJoinStyle;
+begin
+  if ARounded then join := pjsRound else join := pjsMiter;
+  if AHollow then
+    SetEnd(asHollowTriangle, join,AHollowPenWidth, ABackOffset)
+  else
+    SetEnd(asTriangle, join,1, ABackOffset);
+end;
+
+procedure TBGRAArrow.EndAsTail;
+begin
+  SetEnd(asTail);
 end;