1 // SPDX-License-Identifier: GPL-3.0-only
2 unit LCVectorPolyShapes;
3 
4 {$mode objfpc}{$H+}
5 
6 interface
7 
8 uses
9   Classes, SysUtils, Types, LCVectorOriginal, BGRABitmapTypes, BGRALayerOriginal,
10   BGRABitmap, BGRATransform, BGRAGradients, BGRAGraphics,
11   BGRASVGShapes, BGRASVGType, BGRAUnits, BGRAPath;
12 
13 type
14   TArrowKind = (akNone, akTail, akTip, akNormal, akCut, akFlipped, akFlippedCut,
15                 akTriangle, akTriangleBack1, akTriangleBack2,
16                 akHollowTriangle, akHollowTriangleBack1, akHollowTriangleBack2);
17 
18 const
19   errShapeNotHandled = 'Shape not handled';
20   ArrowKindToStr: array[TArrowKind] of string =
21     ('none', 'tail', 'tip', 'normal', 'cut', 'flipped', 'flipped-cut',
22      'triangle', 'triangle-back1', 'triangle-back2',
23      'hollow-triangle', 'hollow-triangle-back1', 'hollow-triangle-back2');
24   LineCapToStr: array[TPenEndCap] of string =
25     ('round','square','flat');
26 
StrToArrowKindnull27 function StrToArrowKind(AStr: string): TArrowKind;
StrToLineCapnull28 function StrToLineCap(AStr: string): TPenEndCap;
29 
30 type
31   TCustomPolypointShape = class;
32   TCustomPolypointPoint = record
33     coord: TPointF;
34     editorIndex: integer;
35     data: cardinal;
36   end;
37 
38   { TCustomPolypointShapeDiff }
39 
40   TCustomPolypointShapeDiff = class(TVectorShapeDiff)
41   protected
42     FStartPoints: array of TCustomPolypointPoint;
43     FStartClosed: boolean;
44     FStartArrowStartKind,FStartArrowEndKind: TArrowKind;
45     FStartArrowSize: TPointF;
46     FStartLineCap: TPenEndCap;
47     FEndPoints: array of TCustomPolypointPoint;
48     FEndClosed: boolean;
49     FEndArrowStartKind,FEndArrowEndKind: TArrowKind;
50     FEndArrowSize: TPointF;
51     FEndLineCap: TPenEndCap;
52   public
53     constructor Create(AStartShape: TVectorShape); override;
54     procedure ComputeDiff(AEndShape: TVectorShape); override;
55     procedure Apply(AStartShape: TVectorShape); override;
56     procedure Unapply(AEndShape: TVectorShape); override;
57     procedure Append(ADiff: TVectorShapeDiff); override;
IsIdentitynull58     function IsIdentity: boolean; override;
59   end;
60 
61   { TCustomPolypointShape }
62 
63   TCustomPolypointShape = class(TVectorShape)
64   private
65     FClosed: boolean;
GetHoverPointnull66     function GetHoverPoint: integer;
GetLineCapnull67     function GetLineCap: TPenEndCap;
GetPointnull68     function GetPoint(AIndex: integer): TPointF;
GetPointCountnull69     function GetPointCount: integer;
70     procedure SetArrowEndKind(AValue: TArrowKind);
71     procedure SetArrowSize(AValue: TPointF);
72     procedure SetArrowStartKind(AValue: TArrowKind);
73     procedure SetCenterPoint(AValue: TPointF);
74     procedure SetHoverCenter(AValue: boolean);
75     procedure SetHoverPoint(AValue: integer);
76     procedure SetLineCap(AValue: TPenEndCap);
77     procedure SetPoint(AIndex: integer; AValue: TPointF);
78   protected
79     FPoints: array of TCustomPolypointPoint;
80     FCenterPoint: TPointF;
81     FCenterPointEditorIndex: integer;
82     FCurPoint: integer;
83     FAddingPoint: boolean;
84     FMousePos: TPointF;
85     FHoverPoint: integer;
86     FHoverCenter: boolean;
87     FArrowStartKind,FArrowEndKind: TArrowKind;
88     FArrowSize: TPointF;
89     FViewMatrix, FViewMatrixInverse, FGridMatrix: TAffineMatrix;
90     procedure OnMovePoint({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState);
91     procedure OnMoveCenterPoint({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState);
92     procedure OnStartMove({%H-}ASender: TObject; APointIndex: integer; {%H-}AShift: TShiftState);
GetCurvenull93     function GetCurve(AMatrix: TAffineMatrix): ArrayOfTPointF; virtual;
GetPathnull94     function GetPath(AMatrix: TAffineMatrix): TBGRAPath; virtual;
95     procedure SetUsermode(AValue: TVectorShapeUsermode); override;
GetClosednull96     function GetClosed: boolean; virtual;
97     procedure SetClosed(AValue: boolean); virtual;
PointsEqualnull98     function PointsEqual(const APoint1, APoint2: TPointF): boolean;
99     procedure OnHoverPoint({%H-}ASender: TObject; APointIndex: integer); virtual;
100     procedure OnClickPoint({%H-}ASender: TObject; APointIndex: integer; {%H-}AShift: TShiftState); virtual;
101     procedure DoClickPoint({%H-}APointIndex: integer; {%H-}AShift: TShiftState); virtual;
CanMovePointsnull102     function CanMovePoints: boolean; virtual;
103     procedure InsertPointAuto(AShift: TShiftState);
ComputeStrokenull104     function ComputeStroke(APoints: ArrayOfTPointF; AClosed: boolean;
105       AStrokeMatrix: TAffineMatrix): ArrayOfTPointF; override;
GetLoopStartIndexnull106     function GetLoopStartIndex: integer;
GetLoopPointCountnull107     function GetLoopPointCount: integer;
GetIsFollowingMousenull108     function GetIsFollowingMouse: boolean; override;
109   public
110     constructor Create(AContainer: TVectorOriginal); override;
111     procedure Clear;
AddPointnull112     function AddPoint(const APoint: TPointF): integer; virtual;
RemovePointnull113     function RemovePoint(AIndex: integer): boolean;
114     procedure RemovePointRange(AFromIndex, AToIndexPlus1: integer);
115     procedure InsertPoint(AIndex: integer; APoint: TPointF);
GetPointBoundsnull116     function GetPointBounds(AMatrix: TAffineMatrix): TRectF;
117     procedure MouseMove({%H-}Shift: TShiftState; X, Y: single; var {%H-}ACursor: TOriginalEditorCursor; var AHandled: boolean); override;
118     procedure MouseDown(RightButton: boolean; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: single; var {%H-}ACursor: TOriginalEditorCursor; var AHandled: boolean); override;
119     procedure KeyDown({%H-}Shift: TShiftState; Key: TSpecialKey; var AHandled: boolean); override;
120     procedure QuickDefine(constref APoint1,APoint2: TPointF); override;
121     procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); override;
122     procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); override;
123     procedure ConfigureCustomEditor(AEditor: TBGRAOriginalEditor); override;
124     procedure TransformFrame(const AMatrix: TAffineMatrix); override;
Usermodesnull125     class function Usermodes: TVectorShapeUsermodes; override;
DefaultArrowSizenull126     class function DefaultArrowSize: TPointF;
127     property Points[AIndex:integer]: TPointF read GetPoint write SetPoint;
128     property PointCount: integer read GetPointCount;
129     property Closed: boolean read GetClosed write SetClosed;
130     property HoverPoint: integer read GetHoverPoint write SetHoverPoint;
131     property HoverCenter: boolean read FHoverCenter write SetHoverCenter;
132     property ArrowStartKind: TArrowKind read FArrowStartKind write SetArrowStartKind;
133     property ArrowEndKind: TArrowKind read FArrowEndKind write SetArrowEndKind;
134     property ArrowSize: TPointF read FArrowSize write SetArrowSize;
135     property LineCap: TPenEndCap read GetLineCap write SetLineCap;
136     property Center: TPointF read FCenterPoint write SetCenterPoint;
137   end;
138 
139   { TPolylineShape }
140 
141   TPolylineShape = class(TCustomPolypointShape)
142   public
Fieldsnull143     class function Fields: TVectorShapeFields; override;
144     procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); overload; override;
AppendToSVGnull145     function AppendToSVG(AContent: TSVGContent; ADefs: TSVGDefine): TSVGElement; override;
GetRenderBoundsnull146     function GetRenderBounds({%H-}ADestRect: TRect; AMatrix: TAffineMatrix; AOptions: TRenderBoundsOptions = []): TRectF; override;
PointInShapenull147     function PointInShape(APoint: TPointF): boolean; overload; override;
PointInShapenull148     function PointInShape(APoint: TPointF; ARadius: single): boolean; overload; override;
PointInBacknull149     function PointInBack(APoint: TPointF): boolean; overload; override;
PointInPennull150     function PointInPen(APoint: TPointF): boolean; overload; override;
GetIsSlownull151     function GetIsSlow(const {%H-}AMatrix: TAffineMatrix): boolean; override;
StorageClassNamenull152     class function StorageClassName: RawByteString; override;
153   end;
154 
155   TCurveShape = class;
156 
157   { TCurveShapeDiff }
158 
159   TCurveShapeDiff = class(TVectorShapeDiff)
160   protected
161     FStartCosineAngle: single;
162     FStartSplineStyle: TSplineStyle;
163     FEndCosineAngle: single;
164     FEndSplineStyle: TSplineStyle;
165   public
166     constructor Create(AStartShape: TVectorShape); override;
167     procedure ComputeDiff(AEndShape: TVectorShape); override;
168     procedure Apply(AStartShape: TVectorShape); override;
169     procedure Unapply(AEndShape: TVectorShape); override;
170     procedure Append(ADiff: TVectorShapeDiff); override;
IsIdentitynull171     function IsIdentity: boolean; override;
172   end;
173 
174   { TCurveShape }
175 
176   TCurveShape = class(TPolylineShape)
177   private
178     FCosineAngle: single;
179     FSplineStyle: TSplineStyle;
GetCurveModenull180     function GetCurveMode(AIndex: integer): TEasyBezierCurveMode;
181     procedure SetCosineAngle(AValue: single);
182     procedure SetCurveMode(AIndex: integer; AValue: TEasyBezierCurveMode);
183     procedure SetSplineStyle(AValue: TSplineStyle);
184   protected
GetCurvenull185     function GetCurve(AMatrix: TAffineMatrix): ArrayOfTPointF; override;
GetPathnull186     function GetPath(AMatrix: TAffineMatrix): TBGRAPath; override;
CanMovePointsnull187     function CanMovePoints: boolean; override;
188     procedure DoClickPoint(APointIndex: integer; {%H-}AShift: TShiftState); override;
189   public
Usermodesnull190     class function Usermodes: TVectorShapeUsermodes; override;
191     constructor Create(AContainer: TVectorOriginal); override;
192     constructor CreateFrom(AContainer: TVectorOriginal; AShape: TVectorShape);
CanCreateFromnull193     class function CanCreateFrom(AShape: TVectorShape): boolean;
AddPointnull194     function AddPoint(const APoint: TPointF): integer; overload; override;
AddPointnull195     function AddPoint(const APoint: TPointF; AMode: TEasyBezierCurveMode): integer; overload;
196     procedure KeyPress(UTF8Key: string; var AHandled: boolean); override;
197     procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); override;
198     procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); override;
StorageClassNamenull199     class function StorageClassName: RawByteString; override;
200     property SplineStyle: TSplineStyle read FSplineStyle write SetSplineStyle;
201     property CurveMode[AIndex: integer]: TEasyBezierCurveMode read GetCurveMode write SetCurveMode;
202     property CosineAngle: single read FCosineAngle write SetCosineAngle;
203   end;
204 
205 procedure ApplyArrowStyle(AArrow: TBGRACustomArrow; AStart: boolean; AKind: TArrowKind; ASize: TPointF);
206 
207 implementation
208 
209 uses BGRAPen, BGRAFillInfo, math, LCVectorialFill,
210   BGRAArrow, LCVectorRectShapes, LCResourceString;
211 
StrToArrowKindnull212 function StrToArrowKind(AStr: string): TArrowKind;
213 var
214   ak: TArrowKind;
215 begin
216   for ak := low(TArrowKind) to high(TArrowKind) do
217     if CompareText(AStr, ArrowKindToStr[ak])=0 then exit(ak);
218   result := akNone;
219 end;
220 
StrToLineCapnull221 function StrToLineCap(AStr: string): TPenEndCap;
222 var
223   ec: TPenEndCap;
224 begin
225   for ec := low(TPenEndCap) to high(TPenEndCap) do
226     if CompareText(AStr, LineCapToStr[ec])=0 then exit(ec);
227   result := pecRound;
228 end;
229 
230 procedure ApplyArrowStyle(AArrow: TBGRACustomArrow; AStart: boolean; AKind: TArrowKind; ASize: TPointF);
231 var backOfs: single;
232 begin
233   backOfs := 0;
234   if (ASize.x = 0) or (ASize.y = 0) then AKind := akNone;
235   if AKind in[akTriangleBack1,akHollowTriangleBack1] then backOfs := 0.25;
236   if AKind in[akTriangleBack2,akHollowTriangleBack2] then backOfs := 0.50;
237   case AKind of
238   akTail: if AStart then AArrow.StartAsTail else AArrow.EndAsTail;
239   akTip: if AStart then AArrow.StartAsTriangle else AArrow.EndAsTriangle;
240   akNormal,akCut,akFlipped,akFlippedCut:
241     if AStart then AArrow.StartAsClassic(AKind in[akFlipped,akFlippedCut], AKind in[akCut,akFlippedCut])
242     else AArrow.EndAsClassic(AKind in[akFlipped,akFlippedCut], AKind in[akCut,akFlippedCut]);
243   akTriangle,akTriangleBack1,akTriangleBack2:
244     if AStart then AArrow.StartAsTriangle(backOfs) else AArrow.EndAsTriangle(backOfs);
245   akHollowTriangle,akHollowTriangleBack1,akHollowTriangleBack2:
246     if AStart then AArrow.StartAsTriangle(backOfs,False,True) else AArrow.EndAsTriangle(backOfs,False,True);
247   else if AStart then AArrow.StartAsNone else AArrow.EndAsNone;
248   end;
249   if (AKind = akTip) and not ((ASize.x = 0) or (ASize.y = 0)) then
250     ASize := ASize*(0.5/ASize.y);
251   if AStart then AArrow.StartSize := ASize else AArrow.EndSize := ASize;
252 end;
253 
254 procedure IncludePointF(var ARectF: TRectF; APointF: TPointF);
255 begin
256   if APointF.x < ARectF.Left then ARectF.Left := APointF.x;
257   if APointF.x > ARectF.Right then ARectF.Right := APointF.x;
258   if APointF.y < ARectF.Top then ARectF.Top := APointF.y;
259   if APointF.y > ARectF.Bottom then ARectF.Bottom := APointF.y;
260 end;
261 
GetPointsBoundsFnull262 function GetPointsBoundsF(const APoints: array of TPointF): TRectF;
263 var
264   i: Integer;
265   firstPoint: Boolean;
266 begin
267   result:= EmptyRectF;
268   firstPoint := true;
269   for i:= 0 to high(APoints) do
270     if not isEmptyPointF(APoints[i]) then
271     begin
272       if firstPoint then
273       begin
274         result.TopLeft := APoints[i];
275         result.BottomRight := APoints[i];
276         firstPoint := false;
277       end else
278         IncludePointF(result, APoints[i]);
279     end;
280 end;
281 
282 { TCurveShapeDiff }
283 
284 constructor TCurveShapeDiff.Create(AStartShape: TVectorShape);
285 begin
286   with (AStartShape as TCurveShape) do
287   begin
288     FStartCosineAngle:= FCosineAngle;
289     FStartSplineStyle:= FSplineStyle;
290   end;
291 end;
292 
293 procedure TCurveShapeDiff.ComputeDiff(AEndShape: TVectorShape);
294 begin
295   with (AEndShape as TCurveShape) do
296   begin
297     FEndCosineAngle:= FCosineAngle;
298     FEndSplineStyle:= FSplineStyle;
299   end;
300 end;
301 
302 procedure TCurveShapeDiff.Apply(AStartShape: TVectorShape);
303 begin
304   with (AStartShape as TCurveShape) do
305   begin
306     BeginUpdate;
307     FCosineAngle := FEndCosineAngle;
308     FSplineStyle := FEndSplineStyle;
309     EndUpdate;
310   end;
311 end;
312 
313 procedure TCurveShapeDiff.Unapply(AEndShape: TVectorShape);
314 begin
315   with (AEndShape as TCurveShape) do
316   begin
317     BeginUpdate;
318     FCosineAngle := FStartCosineAngle;
319     FSplineStyle := FStartSplineStyle;
320     EndUpdate;
321   end;
322 end;
323 
324 procedure TCurveShapeDiff.Append(ADiff: TVectorShapeDiff);
325 var
326   next: TCurveShapeDiff;
327 begin
328   next := ADiff as TCurveShapeDiff;
329   FEndCosineAngle:= next.FEndCosineAngle;
330   FEndSplineStyle:= next.FEndSplineStyle;
331 end;
332 
IsIdentitynull333 function TCurveShapeDiff.IsIdentity: boolean;
334 begin
335   result := (FStartCosineAngle = FEndCosineAngle) and
336     (FStartSplineStyle = FEndSplineStyle);
337 end;
338 
339 { TCustomPolypointShapeDiff }
340 
341 constructor TCustomPolypointShapeDiff.Create(AStartShape: TVectorShape);
342 var
343   i: Integer;
344 begin
345   with (AStartShape as TCustomPolypointShape) do
346   begin
347     setlength(FStartPoints, length(FPoints));
348     for i := 0 to high(FPoints) do FStartPoints[i] := FPoints[i];
349     FStartClosed:= FClosed;
350     FStartArrowStartKind := FArrowStartKind;
351     FStartArrowEndKind:= FArrowEndKind;
352     FStartArrowSize:= FArrowSize;
353     FStartLineCap:= Stroker.LineCap;
354   end;
355 end;
356 
357 procedure TCustomPolypointShapeDiff.ComputeDiff(AEndShape: TVectorShape);
358 var
359   i: Integer;
360 begin
361   with (AEndShape as TCustomPolypointShape) do
362   begin
363     setlength(FEndPoints, length(FPoints));
364     for i := 0 to high(FPoints) do FEndPoints[i] := FPoints[i];
365     FEndClosed:= FClosed;
366     FEndArrowStartKind := FArrowStartKind;
367     FEndArrowEndKind:= FArrowEndKind;
368     FEndArrowSize:= FArrowSize;
369     FEndLineCap:= Stroker.LineCap;
370   end;
371 end;
372 
373 procedure TCustomPolypointShapeDiff.Apply(AStartShape: TVectorShape);
374 var
375   i: Integer;
376 begin
377   with (AStartShape as TCustomPolypointShape) do
378   begin
379     BeginUpdate;
380     setlength(FPoints, length(FEndPoints));
381     for i := 0 to high(FPoints) do FPoints[i] := FEndPoints[i];
382     FClosed := FEndClosed;
383     FArrowStartKind := FEndArrowStartKind;
384     FArrowEndKind := FEndArrowEndKind;
385     FArrowSize := FEndArrowSize;
386     Stroker.LineCap:= FEndLineCap;
387     EndUpdate;
388   end;
389 end;
390 
391 procedure TCustomPolypointShapeDiff.Unapply(AEndShape: TVectorShape);
392 var
393   i: Integer;
394 begin
395   with (AEndShape as TCustomPolypointShape) do
396   begin
397     BeginUpdate;
398     setlength(FPoints, length(FStartPoints));
399     for i := 0 to high(FPoints) do FPoints[i] := FStartPoints[i];
400     FClosed := FStartClosed;
401     FArrowStartKind := FStartArrowStartKind;
402     FArrowEndKind := FStartArrowEndKind;
403     FArrowSize := FStartArrowSize;
404     Stroker.LineCap:= FStartLineCap;
405     EndUpdate;
406   end;
407 end;
408 
409 procedure TCustomPolypointShapeDiff.Append(ADiff: TVectorShapeDiff);
410 var
411   next: TCustomPolypointShapeDiff;
412   i: Integer;
413 begin
414   next := ADiff as TCustomPolypointShapeDiff;
415   setlength(FEndPoints, length(next.FEndPoints));
416   for i := 0 to high(FEndPoints) do FEndPoints[i] := next.FEndPoints[i];
417   FEndClosed := next.FEndClosed;
418   FEndArrowStartKind := next.FEndArrowStartKind;
419   FEndArrowEndKind := next.FEndArrowEndKind;
420   FEndArrowSize := next.FEndArrowSize;
421   FEndLineCap:= next.FEndLineCap;
422 end;
423 
IsIdentitynull424 function TCustomPolypointShapeDiff.IsIdentity: boolean;
425 var
426   i: Integer;
427 begin
428   result := (length(FStartPoints) = length(FEndPoints)) and
429     (FStartClosed = FEndClosed) and
430     (FStartArrowStartKind = FEndArrowStartKind) and
431     (FStartArrowEndKind = FEndArrowEndKind) and
432     (FStartArrowSize = FEndArrowSize) and
433     (FStartLineCap = FEndLineCap);
434   if result then
435   begin
436     for i := 0 to high(FStartPoints) do
437       if (FStartPoints[i].coord<>FEndPoints[i].coord) or
438          (FStartPoints[i].data<>FEndPoints[i].data) then
439       begin
440         result := false;
441         break;
442       end;
443   end;
444 end;
445 
446 { TCustomPolypointShape }
447 
GetClosednull448 function TCustomPolypointShape.GetClosed: boolean;
449 begin
450   result := FClosed;
451 end;
452 
GetPointnull453 function TCustomPolypointShape.GetPoint(AIndex: integer): TPointF;
454 begin
455   if (AIndex < 0) or (AIndex >= length(FPoints)) then
456     raise ERangeError.Create(rsIndexOutOfBounds);
457   result := FPoints[AIndex].coord;
458 end;
459 
GetLineCapnull460 function TCustomPolypointShape.GetLineCap: TPenEndCap;
461 begin
462   result := Stroker.LineCap;
463 end;
464 
TCustomPolypointShape.GetHoverPointnull465 function TCustomPolypointShape.GetHoverPoint: integer;
466 begin
467   if (FHoverPoint >= 0) and (FHoverPoint < PointCount) and
468      not Points[FHoverPoint].IsEmpty then
469        result := FHoverPoint else result := -1;
470 end;
471 
TCustomPolypointShape.GetPointCountnull472 function TCustomPolypointShape.GetPointCount: integer;
473 begin
474   result:= length(FPoints);
475 end;
476 
477 procedure TCustomPolypointShape.SetArrowEndKind(AValue: TArrowKind);
478 begin
479   if FArrowEndKind=AValue then Exit;
480   BeginUpdate(TCustomPolypointShapeDiff);
481   FArrowEndKind:=AValue;
482   EndUpdate;
483 end;
484 
485 procedure TCustomPolypointShape.SetArrowSize(AValue: TPointF);
486 begin
487   if FArrowSize=AValue then Exit;
488   BeginUpdate(TCustomPolypointShapeDiff);
489   FArrowSize:=AValue;
490   EndUpdate;
491 end;
492 
493 procedure TCustomPolypointShape.SetArrowStartKind(AValue: TArrowKind);
494 begin
495   if FArrowStartKind=AValue then Exit;
496   BeginUpdate(TCustomPolypointShapeDiff);
497   FArrowStartKind:=AValue;
498   EndUpdate;
499 end;
500 
501 procedure TCustomPolypointShape.SetCenterPoint(AValue: TPointF);
502 var
503   i: Integer;
504   delta: TPointF;
505 begin
506   if FCenterPoint=AValue then Exit;
507 
508   BeginUpdate(TCustomPolypointShapeDiff);
509   delta := AValue - FCenterPoint;
510   for i := 0 to PointCount-1 do
511     Points[i] := Points[i]+delta;
512   if vsfBackFill in Fields then
513     BackFill.Transform(AffineMatrixTranslation(delta.x, delta.y));
514   if vsfPenFill in Fields then
515     PenFill.Transform(AffineMatrixTranslation(delta.x, delta.y));
516   FCenterPoint:=AValue;
517   EndUpdate;
518 end;
519 
520 procedure TCustomPolypointShape.SetHoverCenter(AValue: boolean);
521 begin
522   if FHoverCenter=AValue then Exit;
523   BeginEditingUpdate;
524   if AValue then FHoverPoint := -1;
525   FHoverCenter:=AValue;
526   EndEditingUpdate;
527 end;
528 
529 procedure TCustomPolypointShape.SetHoverPoint(AValue: integer);
530 begin
531   if (AValue < 0) or (AValue >= PointCount) or
532      Points[AValue].IsEmpty then AValue := -1;
533   if AValue <> FHoverPoint then
534   begin
535     BeginEditingUpdate;
536     FHoverPoint := AValue;
537     if AValue <> -1 then FHoverCenter:= false;
538     EndEditingUpdate;
539   end;
540 end;
541 
542 procedure TCustomPolypointShape.SetLineCap(AValue: TPenEndCap);
543 begin
544   if Stroker.LineCap=AValue then Exit;
545   BeginUpdate(TCustomPolypointShapeDiff);
546   Stroker.LineCap:=AValue;
547   EndUpdate;
548 end;
549 
550 procedure TCustomPolypointShape.SetClosed(AValue: boolean);
551 begin
552   if AValue = FClosed then exit;
553   BeginUpdate(TCustomPolypointShapeDiff);
554   FClosed := AValue;
555   EndUpdate;
556 end;
557 
558 procedure TCustomPolypointShape.SetPoint(AIndex: integer; AValue: TPointF);
559 begin
560   if (AIndex < 0) or (AIndex > length(FPoints)) then
561     raise ERangeError.Create(rsIndexOutOfBounds);
562   BeginUpdate(TCustomPolypointShapeDiff);
563   if AIndex = length(FPoints) then
564   begin
565     setlength(FPoints, length(FPoints)+1);
566     FPoints[AIndex].coord := AValue;
567     FPoints[AIndex].editorIndex := -1;
568     FPoints[AIndex].data := 0;
569   end
570   else
571     FPoints[AIndex].coord := AValue;
572   EndUpdate;
573 end;
574 
575 procedure TCustomPolypointShape.OnMovePoint(ASender: TObject; APrevCoord,
576   ANewCoord: TPointF; AShift: TShiftState);
577 begin
578   if FCurPoint = -1 then exit;
579   Points[FCurPoint] := ANewCoord;
580 end;
581 
582 procedure TCustomPolypointShape.OnMoveCenterPoint(ASender: TObject; APrevCoord,
583   ANewCoord: TPointF; AShift: TShiftState);
584 begin
585   Center := ANewCoord;
586 end;
587 
588 procedure TCustomPolypointShape.OnStartMove(ASender: TObject; APointIndex: integer;
589   AShift: TShiftState);
590 var
591   i: Integer;
592 begin
593   FCurPoint:= -1;
594   for i:= 0 to PointCount-1 do
595     if FPoints[i].editorIndex = APointIndex then
596     begin
597       FCurPoint:= i;
598       break;
599     end;
600 end;
601 
TCustomPolypointShape.GetCurvenull602 function TCustomPolypointShape.GetCurve(AMatrix: TAffineMatrix): ArrayOfTPointF;
603 var
604   i: Integer;
605   m: TAffineMatrix;
606 begin
607   setlength(result, PointCount);
608   m:= MatrixForPixelCentered(AMatrix);
609   for i := 0 to PointCount-1 do
610     result[i] := m*Points[i];
611 end;
612 
TCustomPolypointShape.GetPathnull613 function TCustomPolypointShape.GetPath(AMatrix: TAffineMatrix): TBGRAPath;
614 begin
615   result := TBGRAPath.Create(GetCurve(AMatrix));
616 end;
617 
TCustomPolypointShape.Usermodesnull618 class function TCustomPolypointShape.Usermodes: TVectorShapeUsermodes;
619 begin
620   Result:= inherited Usermodes + [vsuCreate];
621 end;
622 
TCustomPolypointShape.DefaultArrowSizenull623 class function TCustomPolypointShape.DefaultArrowSize: TPointF;
624 begin
625   result := PointF(2,2);
626 end;
627 
628 procedure TCustomPolypointShape.SetUsermode(AValue: TVectorShapeUsermode);
629 var
630   add: Boolean;
631 begin
632   add := AValue = vsuCreate;
633   if add and (PointCount = 0) then exit;
634   if FAddingPoint and not add then
635   begin
636     if (PointCount>1) and PointsEqual(Points[PointCount-1],Points[PointCount-2]) then
637       RemovePoint(PointCount-1);
638     FAddingPoint:= add;
639   end else
640   if not FAddingPoint and add then
641   begin
642     if not isEmptyPointF(FMousePos) then
643       AddPoint(FMousePos)
644     else
645       AddPoint(Points[PointCount-1]);
646     FAddingPoint:= add;
647   end;
648   inherited SetUsermode(AValue);
649 end;
650 
TCustomPolypointShape.PointsEqualnull651 function TCustomPolypointShape.PointsEqual(const APoint1, APoint2: TPointF
652   ): boolean;
653 begin
654   if isEmptyPointF(APoint1) then
655     exit(isEmptyPointF(APoint2))
656   else
657   if isEmptyPointF(APoint2) then exit(false)
658   else
659     exit((APoint1.x = APoint2.x) and (APoint1.y = APoint2.y));
660 end;
661 
662 procedure TCustomPolypointShape.OnHoverPoint(ASender: TObject;
663   APointIndex: integer);
664 var
665   i, newHoverPoint: Integer;
666 begin
667   if APointIndex = FCenterPointEditorIndex then
668   begin
669     HoverCenter := true;
670     exit;
671   end;
672   newHoverPoint:= -1;
673   if APointIndex <> -1 then
674   begin
675     for i:= 0 to PointCount-1 do
676       if FPoints[i].editorIndex = APointIndex then
677       begin
678         newHoverPoint:= i;
679         break;
680       end;
681   end;
682   HoverPoint := newHoverPoint;
683   HoverCenter:= false;
684 end;
685 
686 procedure TCustomPolypointShape.OnClickPoint(ASender: TObject;
687   APointIndex: integer; AShift: TShiftState);
688 var
689   i: Integer;
690 begin
691   if APointIndex <> -1 then
692   begin
693     for i:= 0 to PointCount-1 do
694       if FPoints[i].editorIndex = APointIndex then
695       begin
696         DoClickPoint(i, AShift);
697         break;
698       end;
699   end;
700 end;
701 
702 procedure TCustomPolypointShape.DoClickPoint(APointIndex: integer;
703   AShift: TShiftState);
704 var
705   nb: Integer;
706 begin
707   if FAddingPoint and ((APointIndex = GetLoopStartIndex) or
708      ((APointIndex = PointCount-2) and (ssRight in AShift))) then
709   begin
710     nb := GetLoopPointCount;
711     if nb > 2 then
712     begin
713       BeginUpdate;
714       RemovePoint(PointCount-1);
715       if APointIndex < PointCount-2 then Closed := true;
716       EndUpdate;
717       UserMode := vsuEdit;
718     end else
719     begin
720       if GetLoopStartIndex = 0 then
721         Remove
722       else
723       begin
724         BeginUpdate;
725         while nb > 0 do
726         begin
727           RemovePoint(PointCount-1);
728           dec(nb);
729         end;
730         RemovePoint(PointCount-1); //remove separator
731       end;
732     end;
733   end;
734 end;
735 
CanMovePointsnull736 function TCustomPolypointShape.CanMovePoints: boolean;
737 begin
738   result := true;
739 end;
740 
741 procedure TCustomPolypointShape.InsertPointAuto(AShift: TShiftState);
742 var
743   i,j, loopStart: Integer;
744   bestSegmentIndex,bestPointIndex: integer;
745   bestSegmentDist,bestPointDist, segmentLen, segmentPos: single;
746   u, n, bestProjection: TPointF;
747   segmentDist: single;
748   isLooping: Boolean;
749 begin
750   if isEmptyPointF(FMousePos) then exit;
751 
752   for i := 0 to PointCount-1 do
753     if (Points[i] = FMousePos) and not (FAddingPoint and (i = PointCount-1)) then exit;
754 
755   bestSegmentIndex := -1;
756   bestSegmentDist := MaxSingle;
757   bestProjection := EmptyPointF;
758   loopStart := 0;
759   for i := 0 to PointCount-1 do
760   if FAddingPoint and (i >= PointCount-2) then break else
761   begin
762     if IsEmptyPointF(Points[i]) then
763     begin
764       loopStart := i+1;
765       continue;
766     end;
767     isLooping := (i = PointCount-1) or IsEmptyPointF(Points[i+1]);
768     if isLooping and not Closed then break;
769     if isLooping then
770       j := loopStart
771       else j := i+1;
772     u := Points[j] - Points[i];
773     segmentLen := VectLen(u);
774     if segmentLen > 0 then
775     begin
776       u *= 1/segmentLen;
777       segmentPos := (FMousePos-Points[i])*u;
778       if (segmentPos > 0) and (segmentPos< segmentLen) then
779       begin
780         n := PointF(u.y,-u.x);
781         segmentDist := abs((FMousePos-Points[i])*n);
782         if segmentDist <= bestSegmentDist then
783         begin
784           bestSegmentDist := segmentDist;
785           bestSegmentIndex := i;
786           bestProjection := Points[i]+segmentPos*u;
787         end;
788       end;
789     end;
790   end;
791 
792 
793   bestPointIndex := -1;
794   bestPointDist := MaxSingle;
795   if not FAddingPoint then
796     for i := 0 to PointCount-1 do
797       if ((i = 0) or isEmptyPointF(Points[i-1])) and
798          ((i = PointCount-1) or isEmptyPointF(Points[i+1])) then
799       begin
800         segmentDist := VectLen(FMousePos-Points[i]);
801         if segmentDist < bestPointDist then
802         begin
803           bestPointDist := segmentDist;
804           bestPointIndex := i;
805         end;
806       end;
807 
808   if (bestPointIndex <> -1) and ((bestSegmentIndex = -1) or (bestPointDist < bestSegmentDist)) then
809   begin
810     InsertPoint(bestPointIndex+1, FMousePos);
811     HoverPoint := bestPointIndex+1;
812   end else
813   if bestSegmentIndex <> -1 then
814   begin
815     if ssShift in AShift then
816       InsertPoint(bestSegmentIndex+1, bestProjection)
817     else
818       InsertPoint(bestSegmentIndex+1, FMousePos);
819     HoverPoint:= bestSegmentIndex+1;
820   end;
821 end;
822 
TCustomPolypointShape.ComputeStrokenull823 function TCustomPolypointShape.ComputeStroke(APoints: ArrayOfTPointF;
824   AClosed: boolean; AStrokeMatrix: TAffineMatrix): ArrayOfTPointF;
825 begin
826   if Stroker.Arrow = nil then
827   begin
828     Stroker.Arrow := TBGRAArrow.Create;
829     Stroker.ArrowOwned:= true;
830   end;
831   Stroker.Arrow.LineCap:= LineCap;
832   ApplyArrowStyle(Stroker.Arrow, true, ArrowStartKind, ArrowSize);
833   ApplyArrowStyle(Stroker.Arrow, false, ArrowEndKind, ArrowSize);
834   Result:=inherited ComputeStroke(APoints, AClosed, AStrokeMatrix);
835   Stroker.Arrow.StartAsNone;
836   Stroker.Arrow.EndAsNone;
837 end;
838 
GetLoopStartIndexnull839 function TCustomPolypointShape.GetLoopStartIndex: integer;
840 var
841   i: Integer;
842 begin
843   for i := PointCount-1 downto 0 do
844     if isEmptyPointF(Points[i]) then exit(i+1);
845   exit(0);
846 end;
847 
TCustomPolypointShape.GetLoopPointCountnull848 function TCustomPolypointShape.GetLoopPointCount: integer;
849 begin
850   result := PointCount-GetLoopStartIndex;
851 end;
852 
TCustomPolypointShape.GetIsFollowingMousenull853 function TCustomPolypointShape.GetIsFollowingMouse: boolean;
854 begin
855   Result:= Usermode = vsuCreate;
856 end;
857 
858 constructor TCustomPolypointShape.Create(AContainer: TVectorOriginal);
859 begin
860   inherited Create(AContainer);
861   FMousePos := EmptyPointF;
862   FClosed:= false;
863   FHoverPoint:= -1;
864   FCenterPoint := EmptyPointF;
865 end;
866 
867 procedure TCustomPolypointShape.Clear;
868 begin
869   RemovePointRange(0, PointCount);
870 end;
871 
AddPointnull872 function TCustomPolypointShape.AddPoint(const APoint: TPointF): integer;
873 begin
874   result := PointCount;
875   Points[result] := APoint;
876 end;
877 
TCustomPolypointShape.RemovePointnull878 function TCustomPolypointShape.RemovePoint(AIndex: integer): boolean;
879 begin
880   if (AIndex < 0) or (AIndex >= PointCount) then exit(false);
881   RemovePointRange(AIndex,AIndex+1);
882   result := true;
883 end;
884 
885 procedure TCustomPolypointShape.RemovePointRange(AFromIndex, AToIndexPlus1: integer);
886 var
887   i, delCount: Integer;
888 begin
889   if AFromIndex < 0 then AFromIndex:= 0;
890   if AToIndexPlus1 > PointCount then AToIndexPlus1:= PointCount;
891   if AFromIndex >= AToIndexPlus1 then exit;
892   BeginUpdate(TCustomPolypointShapeDiff);
893   delCount := AToIndexPlus1-AFromIndex;
894   for i := AFromIndex to PointCount-DelCount-1 do
895     FPoints[i] := FPoints[i+delCount];
896   setlength(FPoints, PointCount-delCount);
897   if (HoverPoint >= AFromIndex) and (HoverPoint < AToIndexPlus1) then HoverPoint := -1
898   else if (HoverPoint <> -1) and (HoverPoint >= AToIndexPlus1) then HoverPoint := HoverPoint - delCount;
899   EndUpdate;
900 end;
901 
902 procedure TCustomPolypointShape.InsertPoint(AIndex: integer; APoint: TPointF);
903 var
904   i: Integer;
905 begin
906   if (AIndex < 0) or (AIndex > PointCount) then raise exception.Create(rsIndexOutOfBounds);
907   BeginUpdate(TCustomPolypointShapeDiff);
908   setlength(FPoints, PointCount+1);
909   for i := PointCount-1 downto AIndex+1 do
910     FPoints[i] := FPoints[i-1];
911   FPoints[AIndex].coord := APoint;
912   FPoints[AIndex].editorIndex:= -1;
913   FPoints[AIndex].data := 0;
914   if (HoverPoint <> -1) and (HoverPoint >= AIndex) then HoverPoint := HoverPoint + 1;
915   EndUpdate;
916 end;
917 
GetPointBoundsnull918 function TCustomPolypointShape.GetPointBounds(AMatrix: TAffineMatrix): TRectF;
919 begin
920   result := GetPointsBoundsF(GetCurve(AMatrix));
921 end;
922 
923 procedure TCustomPolypointShape.MouseMove(Shift: TShiftState; X, Y: single; var
924   ACursor: TOriginalEditorCursor; var AHandled: boolean);
925 begin
926   FMousePos := PointF(X,Y);
927   if FAddingPoint then
928   begin
929     BeginUpdate;
930     if (PointCount = 1) and (FMousePos <> Points[PointCount-1]) then
931       Points[PointCount] := FMousePos
932     else
933       Points[PointCount-1] := FMousePos;
934     FillFit;
935     EndUpdate;
936     AHandled:= true;
937   end;
938 end;
939 
940 procedure TCustomPolypointShape.MouseDown(RightButton: boolean;
941   Shift: TShiftState; X, Y: single; var ACursor: TOriginalEditorCursor; var
942   AHandled: boolean);
943 begin
944   FMousePos := PointF(X,Y);
945   if FAddingPoint then
946   begin
947     if not RightButton then
948     begin
949       if (PointCount>1) and not PointsEqual(FMousePos,Points[PointCount-2]) then
950       begin
951         BeginUpdate;
952         Points[PointCount-1] := FMousePos;
953         AddPoint(FMousePos);
954         EndUpdate;
955       end;
956     end else
957       Usermode := vsuEdit;
958     AHandled:= true;
959   end else
960   begin
961     if (ssShift in Shift) and (Usermode = vsuEdit) then
962     begin
963       BeginUpdate;
964       AddPoint(EmptyPointF);
965       AddPoint(FMousePos);
966       FillFit;
967       EndUpdate;
968       UserMode := vsuCreate;
969       AHandled:= true;
970     end;
971   end;
972 end;
973 
974 procedure TCustomPolypointShape.KeyDown(Shift: TShiftState; Key: TSpecialKey;
975   var AHandled: boolean);
976 var
977   nb, idx: Integer;
978   dx, dy, d: TPointF;
979 begin
980   if (Key = skDelete) and (FAddingPoint or (HoverPoint <> -1)) then
981   begin
982     if (HoverPoint <> -1) then
983     begin
984       BeginUpdate(TCustomPolypointShapeDiff);
985       idx := HoverPoint;
986       RemovePoint(idx);
987       if ((idx = PointCount) or IsEmptyPointF(Points[idx])) and
988          ((idx = 0) or IsEmptyPointF(Points[idx-1])) then
989       begin
990         if idx < PointCount then
991           RemovePoint(idx)
992         else if idx > 0 then
993           RemovePoint(idx-1);
994       end;
995       EndUpdate;
996       if PointCount = 0 then self.Remove;
997     end;
998     AHandled:= true;
999   end else
1000   if (Key = skBackspace) and FAddingPoint then
1001   begin
1002     nb := GetLoopPointCount;
1003     if nb > 2 then
1004       RemovePoint(PointCount-2)
1005     else
1006     begin
1007       if GetLoopStartIndex = 0 then self.Remove
1008       else
1009       begin
1010         RemovePointRange(PointCount-3, PointCount);
1011         Usermode:= vsuEdit;
1012       end;
1013     end;
1014     AHandled:= true;
1015   end else
1016   if (Key = skInsert) then
1017   begin
1018     InsertPointAuto(Shift);
1019     AHandled := true;
1020   end else
1021   if (Key in [skLeft,skUp,skRight,skDown]) and ((HoverPoint <> -1) or HoverCenter) then
1022   begin
1023     if ssCtrl in Shift then
1024     begin
1025       dx := PointF(FGridMatrix[1,1], FGridMatrix[2,1]);
1026       dy := PointF(FGridMatrix[1,2], FGridMatrix[2,2]);
1027     end else
1028     begin
1029       dx := PointF(FViewMatrixInverse[1,1], FViewMatrixInverse[2,1]);
1030       dy := PointF(FViewMatrixInverse[1,2], FViewMatrixInverse[2,2]);
1031     end;
1032     case Key of
1033     skLeft: d := -dx;
1034     skRight: d := dx;
1035     skUp: d := -dy;
1036     skDown: d := dy;
1037     end;
1038     if HoverCenter then
1039       Center := Center + d
1040     else
1041       Points[HoverPoint] := Points[HoverPoint] + d;
1042     AHandled := true;
1043   end else
1044     inherited KeyDown(Shift, Key, AHandled);
1045 end;
1046 
1047 procedure TCustomPolypointShape.QuickDefine(constref APoint1, APoint2: TPointF);
1048 begin
1049   BeginUpdate(TCustomPolypointShapeDiff);
1050   FPoints := nil;
1051   AddPoint(APoint1);
1052   if not PointsEqual(APoint1,APoint2) then
1053     AddPoint(APoint2);
1054   EndUpdate;
1055   FMousePos := APoint2;
1056 end;
1057 
1058 procedure TCustomPolypointShape.LoadFromStorage(AStorage: TBGRACustomOriginalStorage);
1059 var
1060   x,y: Array of Single;
1061   i: Integer;
1062 begin
1063   BeginUpdate;
1064   inherited LoadFromStorage(AStorage);
1065   Clear;
1066   x := AStorage.FloatArray['x'];
1067   y := AStorage.FloatArray['y'];
1068   setlength(FPoints, max(length(x),length(y)));
1069   for i := 0 to high(FPoints) do
1070   begin
1071     FPoints[i].coord := PointF(x[i],y[i]);
1072     FPoints[i].editorIndex := -1;
1073     FPoints[i].data := 0;
1074   end;
1075   FClosed:= AStorage.Bool['closed'];
1076   if AStorage.HasAttribute('arrow-size') then
1077     FArrowSize := AStorage.PointF['arrow-size']
1078   else FArrowSize := DefaultArrowSize;
1079   FArrowStartKind:= StrToArrowKind(AStorage.RawString['arrow-start-kind']);
1080   FArrowEndKind:= StrToArrowKind(AStorage.RawString['arrow-end-kind']);
1081   Stroker.LineCap := StrToLineCap(AStorage.RawString['line-cap']);
1082   EndUpdate;
1083 end;
1084 
1085 procedure TCustomPolypointShape.SaveToStorage(AStorage: TBGRACustomOriginalStorage);
1086 var
1087   x,y: Array of Single;
1088   i: Integer;
1089 begin
1090   inherited SaveToStorage(AStorage);
1091   setlength(x, PointCount);
1092   setlength(y, PointCount);
1093   for i:= 0 to PointCount-1 do
1094   begin
1095     x[i] := Points[i].x;
1096     y[i] := Points[i].y;
1097   end;
1098   AStorage.FloatArray['x'] := x;
1099   AStorage.FloatArray['y'] := y;
1100   AStorage.Bool['closed'] := Closed;
1101   if ArrowStartKind=akNone then AStorage.RemoveAttribute('arrow-start-kind')
1102   else AStorage.RawString['arrow-start-kind'] := ArrowKindToStr[ArrowStartKind];
1103   if ArrowEndKind=akNone then AStorage.RemoveAttribute('arrow-end-kind')
1104   else AStorage.RawString['arrow-end-kind'] := ArrowKindToStr[ArrowEndKind];
1105   if (ArrowStartKind=akNone) and (ArrowEndKind=akNone) then AStorage.RemoveAttribute('arrow-size')
1106   else AStorage.PointF['arrow-size'] := FArrowSize;
1107   AStorage.RawString['line-cap'] := LineCapToStr[Stroker.LineCap];
1108 end;
1109 
1110 procedure TCustomPolypointShape.ConfigureCustomEditor(AEditor: TBGRAOriginalEditor);
1111 var
1112   i, nbTotal: Integer;
1113 begin
1114   FViewMatrix := AEditor.Matrix;
1115   if not IsAffineMatrixInversible(FViewMatrix) then exit;
1116   FViewMatrixInverse := AffineMatrixInverse(FViewMatrix);
1117   FGridMatrix := AEditor.GridMatrix;
1118 
1119   AEditor.AddStartMoveHandler(@OnStartMove);
1120   AEditor.AddClickPointHandler(@OnClickPoint);
1121   AEditor.AddHoverPointHandler(@OnHoverPoint);
1122 
1123   FCenterPoint := PointF(0,0);
1124   nbTotal := 0;
1125   for i:= 0 to PointCount-1 do
1126     if isEmptyPointF(Points[i]) then
1127       FPoints[i].editorIndex := -1
1128     else if (FAddingPoint and (i = PointCount-1) and (GetLoopPointCount > 1)) then
1129     begin
1130       FPoints[i].editorIndex := -1;
1131       FCenterPoint += Points[i];
1132       inc(nbTotal);
1133     end
1134     else
1135     begin
1136       if CanMovePoints then
1137         FPoints[i].editorIndex := AEditor.AddPoint(Points[i], @OnMovePoint, false)
1138       else
1139         FPoints[i].editorIndex := AEditor.AddFixedPoint(Points[i], false);
1140       FCenterPoint += Points[i];
1141       if i = HoverPoint then
1142         AEditor.PointHighlighted[FPoints[i].editorIndex] := true;
1143       inc(nbTotal);
1144     end;
1145 
1146   if nbTotal > 0 then
1147     FCenterPoint *= 1/nbTotal
1148     else FCenterPoint := EmptyPointF;
1149 
1150   if (FAddingPoint and (nbTotal > 2)) or (not FAddingPoint and (nbTotal > 1)) then
1151   begin
1152     FCenterPointEditorIndex := AEditor.AddPoint(FCenterPoint, @OnMoveCenterPoint, true);
1153     AEditor.PointHighlighted[FCenterPointEditorIndex] := HoverCenter;
1154   end else
1155     FCenterPointEditorIndex := -1;
1156 end;
1157 
1158 procedure TCustomPolypointShape.TransformFrame(const AMatrix: TAffineMatrix);
1159 var
1160   i: Integer;
1161   m: TAffineMatrix;
1162 begin
1163   BeginUpdate(TCustomPolypointShapeDiff);
1164   m := MatrixForPixelCentered(AMatrix);
1165   for i := 0 to PointCount-1 do
1166     FPoints[i].coord := m*FPoints[i].coord;
1167   EndUpdate;
1168 end;
1169 
1170 { TPolylineShape }
1171 
TPolylineShape.Fieldsnull1172 class function TPolylineShape.Fields: TVectorShapeFields;
1173 begin
1174   Result:= [vsfPenFill, vsfPenWidth, vsfPenStyle, vsfJoinStyle, vsfBackFill];
1175 end;
1176 
1177 procedure TPolylineShape.Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix;
1178   ADraft: boolean);
1179 var
1180   pts: array of TPointF;
1181   backScan, penScan: TBGRACustomScanner;
1182 begin
1183   if not GetBackVisible and not GetPenVisible then exit;
1184   pts := GetCurve(AMatrix);
1185   if GetBackVisible then
1186   begin
1187     if BackFill.FillType = vftSolid then backScan := nil
1188     else backScan := BackFill.CreateScanner(AMatrix, ADraft);
1189 
1190     if ADraft then
1191     begin
1192       if Assigned(backScan) then
1193         ADest.FillPoly(pts, backScan, dmDrawWithTransparency) else
1194         ADest.FillPoly(pts, BackFill.SolidColor, dmDrawWithTransparency);
1195     end
1196     else
1197     begin
1198       if Assigned(backScan) then
1199         ADest.FillPolyAntialias(pts, backScan) else
1200         ADest.FillPolyAntialias(pts, BackFill.SolidColor);
1201     end;
1202 
1203     backScan.Free;
1204   end;
1205   if GetPenVisible then
1206   begin
1207     if PenFill.FillType = vftSolid then penScan := nil
1208     else penScan := PenFill.CreateScanner(AMatrix, ADraft);
1209 
1210     pts := ComputeStroke(pts, Closed, AMatrix);
1211     if ADraft and (PenWidth > 4) then
1212     begin
1213       if Assigned(penScan) then
1214         ADest.FillPoly(pts, penScan, dmDrawWithTransparency) else
1215         ADest.FillPoly(pts, PenColor, dmDrawWithTransparency);
1216     end
1217     else
1218     begin
1219       if Assigned(penScan) then
1220         ADest.FillPolyAntialias(pts, penScan) else
1221         ADest.FillPolyAntialias(pts, PenColor);
1222     end;
1223 
1224     penScan.Free;
1225   end;
1226 end;
1227 
AppendToSVGnull1228 function TPolylineShape.AppendToSVG(AContent: TSVGContent; ADefs: TSVGDefine): TSVGElement;
1229 var
1230   p: TBGRAPath;
1231 begin
1232   p := GetPath(AffineMatrixIdentity);
1233   result := AContent.AppendPath(p.SvgString);
1234   p.Free;
1235   ApplyStrokeStyleToSVG(result, ADefs);
1236   if PenVisible then
1237     result.strokeLineCapLCL := LineCap;
1238   ApplyFillStyleToSVG(result, ADefs);
1239 end;
1240 
GetRenderBoundsnull1241 function TPolylineShape.GetRenderBounds(ADestRect: TRect; AMatrix: TAffineMatrix; AOptions: TRenderBoundsOptions): TRectF;
1242 var
1243   pts: ArrayOfTPointF;
1244   xMargin, yMargin: single;
1245   fillBounds, penBounds: TRectF;
1246 begin
1247   if not (GetBackVisible or (rboAssumeBackFill in AOptions)) and not GetPenVisible(rboAssumePenFill in AOptions) then
1248     result:= EmptyRectF
1249   else
1250   begin
1251     pts := GetCurve(AMatrix);
1252     if GetPenVisible(rboAssumePenFill in AOptions) then
1253     begin
1254       if (JoinStyle = pjsRound) and (ArrowStartKind = akNone) and (ArrowEndKind = akNone) then
1255       begin
1256         xMargin := (abs(AMatrix[1,1])+abs(AMatrix[1,2]))*PenWidth*0.5;
1257         yMargin := (abs(AMatrix[2,1])+abs(AMatrix[2,2]))*PenWidth*0.5;
1258         if LineCap = pecSquare then
1259         begin
1260           xMargin *= sqrt(2);
1261           yMargin *= sqrt(2);
1262         end;
1263         result := GetPointsBoundsF(pts);
1264         result.Left -= xMargin;
1265         result.Top -= yMargin;
1266         result.Right += xMargin;
1267         result.Bottom += yMargin;
1268       end else
1269       begin
1270         if GetBackVisible or (rboAssumeBackFill in AOptions) then fillBounds := GetPointsBoundsF(pts)
1271         else fillBounds := EmptyRectF;
1272         pts := ComputeStroke(pts, Closed, AMatrix);
1273         penBounds := GetPointsBoundsF(pts);
1274         result := fillBounds.Union(penBounds, true);
1275       end;
1276     end
1277     else
1278       result := GetPointsBoundsF(pts);
1279   end;
1280   result.Offset(0.5,0.5);
1281 end;
1282 
PointInShapenull1283 function TPolylineShape.PointInShape(APoint: TPointF): boolean;
1284 var
1285   pts: ArrayOfTPointF;
1286 begin
1287   if not GetBackVisible and not GetPenVisible then exit(false);
1288   pts := GetCurve(AffineMatrixIdentity);
1289   if GetBackVisible and IsPointInPolygon(pts, APoint, true) then exit(true);
1290   if GetPenVisible then
1291   begin
1292     pts := ComputeStroke(pts, Closed, AffineMatrixIdentity);
1293     if IsPointInPolygon(pts, APoint, true) then exit(true);
1294   end;
1295   result := false;
1296 end;
1297 
PointInShapenull1298 function TPolylineShape.PointInShape(APoint: TPointF; ARadius: single): boolean;
1299 var
1300   pts: ArrayOfTPointF;
1301 begin
1302   if not GetBackVisible and not GetPenVisible then exit(false);
1303   pts := GetCurve(AffineMatrixIdentity);
1304   pts := ComputeStrokeEnvelope(pts, Closed, ARadius*2);
1305   result := IsPointInPolygon(pts, APoint, true);
1306 end;
1307 
PointInBacknull1308 function TPolylineShape.PointInBack(APoint: TPointF): boolean;
1309 var
1310   pts: ArrayOfTPointF;
1311   scan: TBGRACustomScanner;
1312 begin
1313   if GetBackVisible then
1314   begin
1315     pts := GetCurve(AffineMatrixIdentity);
1316     result := IsPointInPolygon(pts, APoint, true);
1317     if result and (BackFill.FillType = vftTexture) then
1318     begin
1319       scan := BackFill.CreateScanner(AffineMatrixIdentity, false);
1320       if scan.ScanAt(APoint.X,APoint.Y).alpha = 0 then result := false;
1321       scan.Free;
1322     end;
1323   end else
1324     result := false;
1325 end;
1326 
TPolylineShape.PointInPennull1327 function TPolylineShape.PointInPen(APoint: TPointF): boolean;
1328 var
1329   pts: ArrayOfTPointF;
1330 begin
1331   if GetBackVisible then
1332   begin
1333     pts := GetCurve(AffineMatrixIdentity);
1334     pts := ComputeStroke(pts, Closed, AffineMatrixIdentity);
1335     result := IsPointInPolygon(pts, APoint, true);
1336   end else
1337     result := false;
1338 end;
1339 
GetIsSlownull1340 function TPolylineShape.GetIsSlow(const AMatrix: TAffineMatrix): boolean;
1341 var pts: ArrayOfTPointF;
1342   i: Integer;
1343   ptsBounds: TRectF;
1344   backSurface: Single;
1345   penLength, zoomFactor, penSurface, totalSurface: single;
1346 begin
1347   if not GetPenVisible and not GetBackVisible or (PointCount = 0) then exit(false);
1348 
1349   setlength(pts, PointCount);
1350   for i := 0 to high(pts) do
1351     pts[i] := AMatrix * Points[i];
1352 
1353   if GetPenVisible then
1354   begin
1355     penLength := 0;
1356     zoomFactor := max(VectLen(AMatrix[1,1],AMatrix[2,1]), VectLen(AMatrix[1,2],AMatrix[2,2]));
1357     for i := 0 to high(pts) do
1358       if (i > 0) then
1359       begin
1360         if pts[i-1].IsEmpty then
1361         begin
1362           if not pts[i].IsEmpty and (LineCap <> pecFlat) then penLength += penWidth/2*zoomFactor;
1363         end else
1364         if pts[i].IsEmpty then
1365         begin
1366           if not pts[i-1].IsEmpty and (LineCap <> pecFlat) then penLength += penWidth/2*zoomFactor;
1367         end else
1368           penLength += VectLen(pts[i]-pts[i-1]);
1369       end;
1370     penSurface := penLength*PenWidth*zoomFactor;
1371   end else penSurface := 0;
1372 
1373   if GetBackVisible then
1374   begin
1375     ptsBounds := GetPointsBoundsF(pts);
1376     backSurface := ptsBounds.Width*ptsBounds.Height;
1377   end else
1378     backSurface := 0;
1379 
1380   if GetPenVisible and GetBackVisible then totalSurface := backSurface+penSurface/2
1381   else totalSurface := backSurface+penSurface;
1382 
1383   Result:= (PointCount > 40) or
1384            ((penSurface > 320*240) and PenFill.IsSlow(AMatrix)) or
1385            ((backSurface > 320*240) and BackFill.IsSlow(AMatrix)) or
1386            (totalSurface > 640*480);
1387 end;
1388 
TPolylineShape.StorageClassNamenull1389 class function TPolylineShape.StorageClassName: RawByteString;
1390 begin
1391   result := 'polyline';
1392 end;
1393 
1394 { TCurveShape }
1395 
1396 procedure TCurveShape.SetSplineStyle(AValue: TSplineStyle);
1397 begin
1398   if FSplineStyle=AValue then Exit;
1399   BeginUpdate(TCurveShapeDiff);
1400   FSplineStyle:=AValue;
1401   EndUpdate;
1402 end;
1403 
GetCurveModenull1404 function TCurveShape.GetCurveMode(AIndex: integer): TEasyBezierCurveMode;
1405 begin
1406   if (AIndex < 0) or (AIndex >= PointCount) then exit(cmCurve);
1407   result := TEasyBezierCurveMode(FPoints[AIndex].data);
1408 end;
1409 
1410 procedure TCurveShape.SetCosineAngle(AValue: single);
1411 begin
1412   if FCosineAngle=AValue then Exit;
1413   BeginUpdate(TCurveShapeDiff);
1414   FCosineAngle:=AValue;
1415   EndUpdate;
1416 end;
1417 
1418 procedure TCurveShape.SetCurveMode(AIndex: integer; AValue: TEasyBezierCurveMode);
1419 begin
1420   if (AIndex < 0) or (AIndex >= PointCount) then exit;
1421   if CurveMode[AIndex] = AValue then exit;
1422   BeginUpdate(TCustomPolypointShapeDiff);
1423   FPoints[AIndex].data := ord(AValue);
1424   EndUpdate
1425 end;
1426 
TCurveShape.GetCurvenull1427 function TCurveShape.GetCurve(AMatrix: TAffineMatrix): ArrayOfTPointF;
1428 var
1429   pts: array of TPointF;
1430   cm: array of TEasyBezierCurveMode;
1431   i: Integer;
1432   eb: TEasyBezierCurve;
1433 begin
1434   pts := inherited GetCurve(AMatrix);
1435   if FSplineStyle = ssEasyBezier then
1436   begin
1437     setlength(cm, PointCount);
1438     for i := 0 to PointCount-1 do
1439       cm[i] := CurveMode[i];
1440     eb := EasyBezierCurve(pts, Closed, cm, CosineAngle);
1441     result := eb.ToPoints;
1442   end else
1443   begin
1444     if Closed then result := ComputeClosedSpline(pts, FSplineStyle)
1445     else result := ComputeOpenedSpline(pts, FSplineStyle);
1446   end;
1447 end;
1448 
TCurveShape.GetPathnull1449 function TCurveShape.GetPath(AMatrix: TAffineMatrix): TBGRAPath;
1450 var
1451   pts: array of TPointF;
1452   cm: array of TEasyBezierCurveMode;
1453   i: Integer;
1454   eb: TEasyBezierCurve;
1455 begin
1456   pts := inherited GetCurve(AMatrix);
1457   result := TBGRAPath.Create;
1458   if FSplineStyle = ssEasyBezier then
1459   begin
1460     setlength(cm, PointCount);
1461     for i := 0 to PointCount-1 do
1462       cm[i] := CurveMode[i];
1463     eb := EasyBezierCurve(pts, Closed, cm, CosineAngle);
1464     eb.CopyToPath(result);
1465   end else
1466   begin
1467     if Closed then result.closedSpline(pts, FSplineStyle)
1468     else result.openedSpline(pts, FSplineStyle);
1469   end;
1470 end;
1471 
CanMovePointsnull1472 function TCurveShape.CanMovePoints: boolean;
1473 begin
1474   Result:= Usermode in [vsuCreate,vsuEdit];
1475 end;
1476 
1477 procedure TCurveShape.DoClickPoint(APointIndex: integer; AShift: TShiftState);
1478 begin
1479   case Usermode of
1480   vsuCurveSetAuto: CurveMode[APointIndex] := cmAuto;
1481   vsuCurveSetCurve: CurveMode[APointIndex] := cmCurve;
1482   vsuCurveSetAngle: CurveMode[APointIndex] := cmAngle;
1483   else
1484     inherited DoClickPoint(APointIndex, AShift);
1485   end;
1486 end;
1487 
TCurveShape.Usermodesnull1488 class function TCurveShape.Usermodes: TVectorShapeUsermodes;
1489 begin
1490   Result:=inherited Usermodes + [vsuCurveSetAuto, vsuCurveSetCurve, vsuCurveSetAngle];
1491 end;
1492 
1493 constructor TCurveShape.Create(AContainer: TVectorOriginal);
1494 begin
1495   inherited Create(AContainer);
1496   FSplineStyle:= ssEasyBezier;
1497 end;
1498 
1499 constructor TCurveShape.CreateFrom(AContainer: TVectorOriginal;
1500   AShape: TVectorShape);
1501 var
1502   r: TCustomRectShape;
1503   u, v: TPointF;
1504   p: TCustomPolypointShape;
1505   i: Integer;
1506   f: TVectorShapeFields;
1507   sq2m1: single;
1508 begin
1509   Create(AContainer);
1510   if AShape is TEllipseShape then
1511   begin
1512     r := AShape as TCustomRectShape;
1513     u := r.XAxis-r.Origin;
1514     v := r.YAxis-r.Origin;
1515     sq2m1 := sqrt(2)-1;
1516     AddPoint(r.Origin-v+u*sq2m1);
1517     AddPoint(r.Origin-v*sq2m1+u);
1518     AddPoint(r.Origin+v*sq2m1+u);
1519     AddPoint(r.Origin+v+u*sq2m1);
1520     AddPoint(r.Origin+v-u*sq2m1);
1521     AddPoint(r.Origin+v*sq2m1-u);
1522     AddPoint(r.Origin-v*sq2m1-u);
1523     AddPoint(r.Origin-v-u*sq2m1);
1524     Closed := true;
1525   end else
1526   if AShape is TRectShape then
1527   begin
1528     r := AShape as TCustomRectShape;
1529     u := r.XAxis-r.Origin;
1530     v := r.YAxis-r.Origin;
1531     AddPoint(r.Origin-v-u, cmAngle);
1532     AddPoint(r.Origin-v+u, cmAngle);
1533     AddPoint(r.Origin+v+u, cmAngle);
1534     AddPoint(r.Origin+v-u, cmAngle);
1535     Closed := true;
1536   end else
1537   if (AShape is TPolylineShape) and not
1538      (AShape is TCurveShape) then
1539   begin
1540     p := AShape as TCustomPolypointShape;
1541     for i := 0 to p.PointCount-1 do
1542       AddPoint(p.Points[i], cmAngle);
1543     Closed := p.Closed;
1544   end else
1545     raise exception.Create(errShapeNotHandled);
1546 
1547   f := AShape.Fields;
1548   if vsfPenFill in f then PenFill.Assign(AShape.PenFill);
1549   if vsfPenWidth in f then PenWidth := AShape.PenWidth;
1550   if vsfPenStyle in f then PenStyle := AShape.PenStyle;
1551   if vsfJoinStyle in f then JoinStyle := AShape.JoinStyle;
1552   if vsfBackFill in f then BackFill.Assign(AShape.BackFill);
1553 end;
1554 
TCurveShape.CanCreateFromnull1555 class function TCurveShape.CanCreateFrom(AShape: TVectorShape): boolean;
1556 begin
1557   result := (AShape is TEllipseShape) or
1558     (AShape is TRectShape) or
1559     ((AShape is TPolylineShape) and not
1560      (AShape is TCurveShape));
1561 end;
1562 
AddPointnull1563 function TCurveShape.AddPoint(const APoint: TPointF): integer;
1564 begin
1565   if (PointCount > 1) and (APoint = Points[PointCount-1]) then
1566   begin
1567     BeginUpdate;
1568     CurveMode[PointCount-1] := CurveMode[PointCount-2];
1569     Result:=inherited AddPoint(APoint);
1570     EndUpdate;
1571   end
1572   else Result:=inherited AddPoint(APoint);
1573 end;
1574 
AddPointnull1575 function TCurveShape.AddPoint(const APoint: TPointF; AMode: TEasyBezierCurveMode): integer;
1576 begin
1577   result := inherited AddPoint(APoint);
1578   CurveMode[result] := AMode;
1579 end;
1580 
1581 procedure TCurveShape.KeyPress(UTF8Key: string; var AHandled: boolean);
1582 var
1583   targetPoint: Integer;
1584 begin
1585   if HoverPoint<>-1 then
1586     targetPoint := HoverPoint
1587   else if FAddingPoint and (PointCount > 1) then
1588     targetPoint := PointCount-2
1589   else
1590     targetPoint := -1;
1591   if (targetPoint >= 0) and (targetPoint < PointCount) then
1592   begin
1593     if (UTF8Key = 'A') or (UTF8Key = 'a') then
1594     begin
1595       CurveMode[targetPoint] := cmAuto;
1596       AHandled := true;
1597     end else
1598     if (UTF8Key = 'S') or (UTF8Key = 's') then
1599     begin
1600       CurveMode[targetPoint] := cmCurve;
1601       AHandled:= true;
1602     end else
1603     if (UTF8Key = 'X') or (UTF8Key = 'x') then
1604     begin
1605       CurveMode[targetPoint] := cmAngle;
1606       AHandled:= true;
1607     end;
1608   end;
1609   if not AHandled then
1610     inherited KeyPress(UTF8Key, AHandled);
1611 end;
1612 
1613 procedure TCurveShape.LoadFromStorage(AStorage: TBGRACustomOriginalStorage);
1614 var
1615   i: Integer;
1616   cm: array of Single;
1617 begin
1618   BeginUpdate;
1619   inherited LoadFromStorage(AStorage);
1620   case AStorage.RawString['spline-style'] of
1621   'inside': SplineStyle := ssInside;
1622   'inside+ends': SplineStyle := ssInsideWithEnds;
1623   'crossing': SplineStyle := ssCrossing;
1624   'crossing+ends': SplineStyle := ssCrossingWithEnds;
1625   'outside': SplineStyle := ssOutside;
1626   'round-outside': SplineStyle := ssRoundOutside;
1627   'vertex-to-side': SplineStyle := ssVertexToSide;
1628   else
1629     {'easy-bezier'} SplineStyle := ssEasyBezier;
1630   end;
1631   if SplineStyle = ssEasyBezier then
1632   begin
1633     cm := AStorage.FloatArray['curve-mode'];
1634     for i := 0 to min(high(cm),PointCount-1) do
1635       case round(cm[i]) of
1636       1: CurveMode[i] := cmCurve;
1637       2: CurveMode[i] := cmAngle;
1638       end;
1639     if length(cm) < PointCount then
1640       for i:= length(cm) to PointCount-1 do
1641         CurveMode[i] := cmCurve;
1642   end;
1643   CosineAngle := AStorage.FloatDef['cosine-angle', EasyBezierDefaultMinimumDotProduct];
1644   EndUpdate;
1645 end;
1646 
1647 procedure TCurveShape.SaveToStorage(AStorage: TBGRACustomOriginalStorage);
1648 var s: string;
1649   cm: array of single;
1650   i: Integer;
1651 begin
1652   inherited SaveToStorage(AStorage);
1653   case SplineStyle of
1654     ssInside: s := 'inside';
1655     ssInsideWithEnds: s := 'inside+ends';
1656     ssCrossing: s := 'crossing';
1657     ssCrossingWithEnds: s := 'crossing+ends';
1658     ssOutside: s := 'outside';
1659     ssRoundOutside: s := 'round-outside';
1660     ssVertexToSide: s := 'vertex-to-side';
1661     ssEasyBezier: s := 'easy-bezier';
1662   else s := '';
1663   end;
1664   AStorage.RawString['spline-style'] := s;
1665   if SplineStyle = ssEasyBezier then
1666   begin
1667     setlength(cm, PointCount);
1668     for i := 0 to PointCount-1 do
1669       cm[i] := ord(CurveMode[i]);
1670     AStorage.FloatArray['curve-mode'] := cm;
1671   end;
1672   AStorage.Float['cosine-angle'] := CosineAngle;
1673 end;
1674 
TCurveShape.StorageClassNamenull1675 class function TCurveShape.StorageClassName: RawByteString;
1676 begin
1677   Result:= 'curve';
1678 end;
1679 
1680 initialization
1681 
1682   RegisterVectorShape(TPolylineShape);
1683   RegisterVectorShape(TCurveShape);
1684 
1685 end.
1686 
1687