1 // SPDX-License-Identifier: LGPL-3.0-linking-exception
2 unit BGRAPath;
3 
4 {$mode objfpc}{$H+}
5 
6 interface
7 
8 //todo: tangent interpolation
9 
10 { There are different conventions for angles.
11 
12   First is about the unit. It can be one of the following:
13   - degrees (0..360)
14   - radian (0..2*Pi)
15   - tenth of degrees (0..3600)
16   - from 0 to 65536
17 
18   Second is about the origin. It can be one of the following:
19   - right-most position (this is the default origin for radian and 65536)
20   - top-most position (this is the default origin for degrees)
21 
22   Third is about the sign. It can be one of the following:
23   - positive is clockwise (this is the default for degrees)
24   - positive is counterclockwise (this is the default for radian and 65536)
25 
26   TBGRAPath and TBGRACanvas2D follow HTML5 convention which is:
27     (radian, right-most, clockwise) that can be shortened to (radian, clockwise)
28     because right-most is the default for radian. This is abbreviated as "radCW".
29 
30   When radian are CCW, it is also specified in order to make it clear, even
31   if it is the default convention in mathematics.
32 
33   In order to make things easier, there are some functions that accept angles
34   in degrees. The convention used here is the usual degree convention:
35     (degrees, top-most, clockwise) that can be shortened to (degree)
36     because top-most and clockwise is the default for degrees.
37 
38   }
39 
40 uses
41   BGRABitmapTypes, BGRATransform;
42 
43 const
44   DefaultDeviation = 0.1;
45 
46 type
47   TBGRAPathElementType = (peNone, peMoveTo, peLineTo, peCloseSubPath,
48     peQuadraticBezierTo, peCubicBezierTo, peArc, peOpenedSpline,
49     peClosedSpline);
50 
51   TBGRAPathDrawProc = BGRABitmapTypes.TBGRAPathDrawProc;
52   TBGRAPathFillProc = BGRABitmapTypes.TBGRAPathFillProc;
53 
54   TBGRAPath = class;
55 
56   { TBGRAPathCursor }
57 
58   TBGRAPathCursor = class(TBGRACustomPathCursor)
59   protected
60     FPath: TBGRAPath;
61     FDataPos: IntPtr;
62     FAcceptedDeviation: single;
63     FPathLength: single;
64     FPathLengthComputed: boolean;
65     FBounds: TRectF;
66     FBoundsComputed: boolean;
67     FArcPos: Single;
68 
69     FStartCoordinate: TPointF;
70     FEndCoordinate: TPointF;
71     FLoopClosedShapes,FLoopPath: boolean;
72 
73     FCurrentElementType: TBGRAPathElementType;
74     FCurrentElement: Pointer;
75     FCurrentElementArcPos,
76     FCurrentElementArcPosScale: single;
77     FCurrentElementStartCoord,
78     FCurrentElementEndCoord: TPointF;
79     FCurrentElementLength: single;
80     FCurrentElementPoints: array of TPointF;
81     FCurrentSegment: Int32or64;
82     FCurrentSegmentPos: single;
GoToNextElementnull83     function GoToNextElement(ACanJump: boolean): boolean;
GoToPreviousElementnull84     function GoToPreviousElement(ACanJump: boolean): boolean;
85     procedure MoveToEndOfElement;
86     procedure MoveForwardInElement(ADistance: single);
87     procedure MoveBackwardInElement(ADistance: single);
NeedPolygonalApproxnull88     function NeedPolygonalApprox: boolean;
89     procedure OnPathFree; virtual;
90 
GetLoopClosedShapesnull91     function GetLoopClosedShapes: boolean; override;
GetLoopPathnull92     function GetLoopPath: boolean; override;
GetStartCoordinatenull93     function GetStartCoordinate: TPointF; override;
94     procedure SetLoopClosedShapes(AValue: boolean); override;
95     procedure SetLoopPath(AValue: boolean); override;
96 
GetArcPosnull97     function GetArcPos: single; override;
GetCurrentTangentnull98     function GetCurrentTangent: TPointF; override;
99     procedure SetArcPos(AValue: single); override;
GetBoundsnull100     function GetBounds: TRectF; override;
GetPathLengthnull101     function GetPathLength: single; override;
102     procedure PrepareCurrentElement; virtual;
GetCurrentCoordnull103     function GetCurrentCoord: TPointF; override;
GetPathnull104     function GetPath: TBGRAPath; virtual;
105   public
106     constructor Create(APath: TBGRAPath; AAcceptedDeviation: single = DefaultDeviation);
MoveForwardnull107     function MoveForward(ADistance: single; ACanJump: boolean = true): single; override;
MoveBackwardnull108     function MoveBackward(ADistance: single; ACanJump: boolean = true): single; override;
109     destructor Destroy; override;
110     property CurrentCoordinate: TPointF read GetCurrentCoord;
111     property CurrentTangent: TPointF read GetCurrentTangent;
112     property Position: single read GetArcPos write SetArcPos;
113     property PathLength: single read GetPathLength;
114     property Path: TBGRAPath read GetPath;
115     property Bounds: TRectF read GetBounds;
116     property StartCoordinate: TPointF read GetStartCoordinate;
117     property LoopClosedShapes: boolean read GetLoopClosedShapes write SetLoopClosedShapes;
118     property LoopPath: boolean read GetLoopPath write SetLoopPath;
119     property AcceptedDeviation: single read FAcceptedDeviation;
120   end;
121 
122   { TBGRAPath }
123 
124   TBGRAPath = class(TBGRACustomPath)
125   protected
126     FData: PByte;
127     FDataCapacity: PtrInt;
128     FDataPos: PtrInt;
129     FLastSubPathElementType, FLastStoredElementType: TBGRAPathElementType;
130     FLastMoveToDataPos: PtrInt;
131     FLastCoord,FLastTransformedCoord,
132     FSubPathStartCoord, FSubPathTransformedStartCoord: TPointF;
133     FExpectedTransformedControlPoint: TPointF;
134     FMatrix: TAffineMatrix; //this matrix must have a base of vectors
135                             //orthogonal, of same length and with positive
136                             //orientation in order to preserve arcs
137     FScale,FAngleRadCW: single;
138     FCursors: array of TBGRAPathCursor;
139     FInternalDrawOffset: TPointF;
140     procedure OnModify;
141     procedure OnMatrixChange;
142     procedure NeedSpace(count: integer);
AllocateElementnull143     function AllocateElement(AElementType: TBGRAPathElementType;
144   AExtraBytes: PtrInt = 0): Pointer;
145     procedure Init;
146     procedure DoClear;
CheckElementTypenull147     function CheckElementType(AElementType: TBGRAPathElementType): boolean;
GoToNextElementnull148     function GoToNextElement(var APos: PtrInt): boolean;
GoToPreviousElementnull149     function GoToPreviousElement(var APos: PtrInt): boolean;
PeekNextElementnull150     function PeekNextElement(APos: PtrInt): TBGRAPathElementType;
GetElementStartCoordnull151     function GetElementStartCoord(APos: PtrInt): TPointF;
GetElementEndCoordnull152     function GetElementEndCoord(APos: PtrInt): TPointF;
GetElementLengthnull153     function GetElementLength(APos: PtrInt; AAcceptedDeviation: single): Single;
154     procedure GetElementAt(APos: PtrInt;
155       out AElementType: TBGRAPathElementType; out AElement: pointer);
GetSvgStringnull156     function GetSvgString: string; virtual;
157     procedure SetSvgString(const AValue: string); virtual;
158     procedure RegisterCursor(ACursor: TBGRAPathCursor);
159     procedure UnregisterCursor(ACursor: TBGRAPathCursor);
SetLastCoordnull160     function SetLastCoord(ACoord: TPointF): TPointF; inline;
161     procedure ClearLastCoord;
162     procedure BezierCurveFromTransformed(tcp1, cp2, pt:TPointF);
163     procedure QuadraticCurveFromTransformed(tcp, pt: TPointF);
LastCoordDefinednull164     function LastCoordDefined: boolean; inline;
GetPolygonalApproxnull165     function GetPolygonalApprox(APos: IntPtr; AAcceptedDeviation: single; AIncludeFirstPoint: boolean): ArrayOfTPointF;
getPointsnull166     function getPoints: ArrayOfTPointF; overload;override;
getPointsnull167     function getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF; overload;override;
getLengthnull168     function getLength: single; override;
getCursornull169     function getCursor: TBGRACustomPathCursor; override;
170     procedure InternalDraw(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer);
171     procedure BitmapDrawSubPathProc(const APoints: array of TPointF; AClosed: boolean; AData: pointer);
CorrectAcceptedDeviationnull172     function CorrectAcceptedDeviation(AAcceptedDeviation: single; const AMatrix: TAffineMatrix): single;
173   public
174     constructor Create; overload; override;
175     constructor Create(ASvgString: string); overload;
176     constructor Create(const APoints: ArrayOfTPointF); overload;
177     constructor Create(APath: IBGRAPath); overload;
178     destructor Destroy; override;
179     procedure beginPath; override;
180     procedure beginSubPath;
181     procedure closePath; override;
182     procedure translate(x,y: single);
183     procedure resetTransform;
184     procedure rotate(angleRadCW: single); overload;
185     procedure rotateDeg(angleDeg: single); overload;
186     procedure rotate(angleRadCW: single; center: TPointF); overload;
187     procedure rotateDeg(angleDeg: single; center: TPointF); overload;
188     procedure scale(factor: single);
189     procedure moveTo(x,y: single); overload;
190     procedure lineTo(x,y: single); overload;
191     procedure moveTo(constref pt: TPointF); overload; override;
192     procedure lineTo(constref pt: TPointF); overload; override;
193     procedure polyline(const pts: array of TPointF);
194     procedure polylineTo(const pts: array of TPointF); override;
195     procedure polygon(const pts: array of TPointF);
196     procedure quadraticCurveTo(cpx,cpy,x,y: single); overload;
197     procedure quadraticCurveTo(constref cp,pt: TPointF); overload; override;
198     procedure quadraticCurve(const curve: TQuadraticBezierCurve); overload;
199     procedure quadraticCurve(p1,cp,p2: TPointF); overload;
200     procedure smoothQuadraticCurveTo(x,y: single); overload;
201     procedure smoothQuadraticCurveTo(const pt: TPointF); overload;
202     procedure bezierCurveTo(cp1x,cp1y,cp2x,cp2y,x,y: single); overload;
203     procedure bezierCurveTo(constref cp1,cp2,pt: TPointF); overload; override;
204     procedure bezierCurve(const curve: TCubicBezierCurve); overload;
205     procedure bezierCurve(p1,cp1,cp2,p2: TPointF); overload;
206     procedure smoothBezierCurveTo(cp2x,cp2y,x,y: single); overload;
207     procedure smoothBezierCurveTo(const cp2,pt: TPointF); overload;
208     procedure rect(x,y,w,h: single);
209     procedure roundRect(x,y,w,h,radius: single);
210     procedure arc(cx, cy, radius, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean); overload;
211     procedure arc(cx, cy, radius, startAngleRadCW, endAngleRadCW: single); overload;
212     procedure arcDeg(cx, cy, radius, startAngleDeg, endAngleDeg: single; anticlockwise: boolean); overload;
213     procedure arcDeg(cx, cy, radius, startAngleDeg, endAngleDeg: single); overload;
214     procedure arcTo(x1, y1, x2, y2, radius: single); overload;
215     procedure arcTo(const p1,p2: TPointF; radius: single); overload;
216     procedure arc(constref arcDef: TArcDef); overload; override;
217     procedure arc(cx, cy, rx,ry: single; xAngleRadCW, startAngleRadCW, endAngleRadCW: single); overload;
218     procedure arc(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean); overload;
219     procedure arcTo(rx,ry, xAngleRadCW: single; largeArc, anticlockwise: boolean; x,y:single); overload;
220     procedure copyTo(dest: IBGRAPath); override;
221     procedure addPath(const AValue: string); overload;
222     procedure addPath(source: IBGRAPath); overload;
223     procedure openedSpline(const pts: array of TPointF; style: TSplineStyle); override;
224     procedure closedSpline(const pts: array of TPointF; style: TSplineStyle); override;
225     property SvgString: string read GetSvgString write SetSvgString;
ComputeLengthnull226     function ComputeLength(AAcceptedDeviation: single = DefaultDeviation): single;
ToPointsnull227     function ToPoints(AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload;
ToPointsnull228     function ToPoints(AMatrix: TAffineMatrix; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload;
IsEmptynull229     function IsEmpty: boolean;
GetBoundsnull230     function GetBounds(AAcceptedDeviation: single = DefaultDeviation): TRectF;
231     procedure SetPoints(const APoints: ArrayOfTPointF);
232     procedure stroke(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload;
233     procedure stroke(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload;
234     procedure stroke(ABitmap: TBGRACustomBitmap; x,y: single; AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload;
235     procedure stroke(ABitmap: TBGRACustomBitmap; x,y: single; ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload;
236     procedure stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload;
237     procedure stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single = DefaultDeviation); overload;
238     procedure stroke(ADrawProc: TBGRAPathDrawProc; AData: pointer); overload; override;
239     procedure stroke(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AData: pointer); overload; override;
240     procedure stroke(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer = nil); overload;
241     procedure fill(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel; AAcceptedDeviation: single = DefaultDeviation); overload;
242     procedure fill(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner; AAcceptedDeviation: single = DefaultDeviation); overload;
243     procedure fill(ABitmap: TBGRACustomBitmap; x,y: single; AColor: TBGRAPixel; AAcceptedDeviation: single = DefaultDeviation); overload;
244     procedure fill(ABitmap: TBGRACustomBitmap; x,y: single; ATexture: IBGRAScanner; AAcceptedDeviation: single = DefaultDeviation); overload;
245     procedure fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; AColor: TBGRAPixel; AAcceptedDeviation: single = DefaultDeviation); overload;
246     procedure fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AAcceptedDeviation: single = DefaultDeviation); overload;
247     procedure fill(AFillProc: TBGRAPathFillProc; AData: pointer); overload; override;
248     procedure fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; AData: pointer); overload; override;
249     procedure fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer = nil); overload;
CreateCursornull250     function CreateCursor(AAcceptedDeviation: single = DefaultDeviation): TBGRAPathCursor;
251     procedure Fit(ARect: TRectF; AAcceptedDeviation: single = DefaultDeviation);
252     procedure FitInto(ADest: TBGRAPath; ARect: TRectF; AAcceptedDeviation: single = DefaultDeviation);
253   end;
254 
255 {----------------------- Spline ------------------}
256 
SplineVertexToSidenull257 function SplineVertexToSide(y0, y1, y2, y3: single; t: single): single;
ComputeBezierCurvenull258 function ComputeBezierCurve(const curve: TCubicBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload;
ComputeBezierCurvenull259 function ComputeBezierCurve(const curve: TQuadraticBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload;
ComputeBezierSplinenull260 function ComputeBezierSpline(const spline: array of TCubicBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload;
ComputeBezierSplinenull261 function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload;
ComputeClosedSplinenull262 function ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF;
ComputeClosedSplinenull263 function ComputeClosedSpline(const APoints: array of TPointF; AStart, ACount: integer; AStyle: TSplineStyle; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF;
ComputeOpenedSplinenull264 function ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle; AEndCoeff: single = 0.25; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF;
ComputeOpenedSplinenull265 function ComputeOpenedSpline(const APoints: array of TPointF; AStart, ACount: integer; AStyle: TSplineStyle; AEndCoeff: single = 0.25; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF;
ClosedSplineStartPointnull266 function ClosedSplineStartPoint(const points: array of TPointF; Style: TSplineStyle): TPointF;
ComputeEasyBeziernull267 function ComputeEasyBezier(const curve: TEasyBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF;
268 
269 { Compute points to draw an antialiased ellipse }
ComputeEllipsenull270 function ComputeEllipse(x,y,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload;
ComputeEllipsenull271 function ComputeEllipse(AOrigin, AXAxis, AYAxis: TPointF; quality: single = 1): ArrayOfTPointF; overload;
ComputeArc65536null272 function ComputeArc65536(x, y, rx, ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; overload;
ComputeArc65536null273 function ComputeArc65536(AOrigin, AXAxis, AYAxis: TPointF; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; overload;
ComputeArcRadnull274 function ComputeArcRad(x, y, rx, ry: single; startRadCCW,endRadCCW: single; quality: single = 1): ArrayOfTPointF; overload;
ComputeArcRadnull275 function ComputeArcRad(AOrigin, AXAxis, AYAxis: TPointF; startRadCCW,endRadCCW: single; quality: single = 1): ArrayOfTPointF; overload;
ComputeArcnull276 function ComputeArc(const arc: TArcDef; quality: single = 1): ArrayOfTPointF;
ComputeRoundRectnull277 function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload;
ComputeRoundRectnull278 function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; options: TRoundRectangleOptions; quality: single = 1): ArrayOfTPointF; overload;
279 
Html5ArcTonull280 function Html5ArcTo(const p0, p1, p2: TPointF; radius: single): TArcDef;
SvgArcTonull281 function SvgArcTo(const p0: TPointF; rx, ry, xAngleRadCW: single; largeArc,
282   anticlockwise: boolean; const p1: TPointF): TArcDef;
ArcStartPointnull283 function ArcStartPoint(const arc: TArcDef): TPointF;
ArcEndPointnull284 function ArcEndPoint(const arc: TArcDef): TPointF;
IsLargeArcnull285 function IsLargeArc(const arc: TArcDef): boolean;
286 
287 implementation
288 
289 uses Math, BGRAClasses, BGRAResample, SysUtils;
290 
291 type
292   TStrokeData = record
293     Bitmap: TBGRACustomBitmap;
294     Texture: IBGRAScanner;
295     Color: TBGRAPixel;
296     Width: Single;
297   end;
298 
299   PPathElementHeader = ^TPathElementHeader;
300   TPathElementHeader = record
301     ElementType: TBGRAPathElementType;
302     PreviousElementType: TBGRAPathElementType;
303   end;
304   PMoveToElement = ^TMoveToElement;
305   TMoveToElement = record
306     StartCoordinate: TPointF;
307     LoopDataPos: PtrInt; //if the path is closed
308   end;
309   PClosePathElement = ^TClosePathElement;
310   TClosePathElement = type TMoveToElement;
311   PQuadraticBezierToElement = ^TQuadraticBezierToElement;
312   TQuadraticBezierToElement = record
313     ControlPoint, Destination: TPointF;
314   end;
315   PCubicBezierToElement = ^TCubicBezierToElement;
316   TCubicBezierToElement = record
317     ControlPoint1, ControlPoint2, Destination: TPointF;
318   end;
319   PArcElement = ^TArcElement;
320   TArcElement = TArcDef;
321 
322   PSplineElement = ^TSplineElement;
323   TSplineElement = record
324     SplineStyle: TSplineStyle;
325     NbControlPoints: integer;
326   end;
327 
328 const
329   PathElementSize : array[TBGRAPathElementType] of PtrInt =
330   (0, Sizeof(TMoveToElement), Sizeof(TClosePathElement), sizeof(TPointF),
331    sizeof(TQuadraticBezierToElement), sizeof(TCubicBezierToElement),
332    sizeof(TArcElement), sizeof(TSplineElement)+sizeof(integer),
333    sizeof(TSplineElement)+sizeof(integer));
334 
SplineVertexToSidenull335 function SplineVertexToSide(y0, y1, y2, y3: single; t: single): single;
336 var
337   a0, a1, a2, a3: single;
338   t2: single;
339 begin
340   t2     := t * t;
341   a0     := y3 - y2 - y0 + y1;
342   a1     := y0 - y1 - a0;
343   a2     := y2 - y0;
344   a3     := y1;
345   Result := a0 * t * t2 + a1 * t2 + a2 * t + a3;
346 end;
347 
ComputeCurvePartPrecisionnull348 function ComputeCurvePartPrecision(pt1, pt2, pt3, pt4: TPointF; AAcceptedDeviation: single = DefaultDeviation): integer;
349 var
350   len: single;
351 begin
352   len    := sqr(pt1.x - pt2.x) + sqr(pt1.y - pt2.y);
353   len    := max(len, sqr(pt3.x - pt2.x) + sqr(pt3.y - pt2.y));
354   len    := max(len, sqr(pt3.x - pt4.x) + sqr(pt3.y - pt4.y));
355   Result := round(sqrt(sqrt(len)/AAcceptedDeviation) * 0.9);
356   if Result<=0 then Result:=1;
357 end;
358 
ComputeBezierCurvenull359 function ComputeBezierCurve(const curve: TCubicBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload;
360 begin
361   result := curve.ToPoints(AAcceptedDeviation);
362 end;
363 
ComputeBezierCurvenull364 function ComputeBezierCurve(const curve: TQuadraticBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF; overload;
365 begin
366   result := curve.ToPoints(AAcceptedDeviation);
367 end;
368 
ComputeBezierSplinenull369 function ComputeBezierSpline(const spline: array of TCubicBezierCurve; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF;
370 var
371   curves: array of array of TPointF;
372   nb: integer;
373   lastPt: TPointF;
374   i: Integer;
375   j: Integer;
376 
377   procedure AddPt(pt: TPointF); inline;
378   begin
379     result[nb]:= pt;
380     inc(nb);
381     lastPt := pt;
382   end;
383 
EqLastnull384   function EqLast(pt: TPointF): boolean;
385   begin
386     result := (pt.x = lastPt.x) and (pt.y = lastPt.y);
387   end;
388 
389 begin
390   if length(spline)= 0 then
391   begin
392     setlength(result,0);
393     exit;
394   end;
395   setlength(curves, length(spline));
396   for i := 0 to high(spline) do
397     curves[i] := ComputeBezierCurve(spline[i],AAcceptedDeviation);
398   nb := length(curves[0]);
399   lastPt := curves[0][high(curves[0])];
400   for i := 1 to high(curves) do
401   begin
402     inc(nb,length(curves[i]));
403     if EqLast(curves[i][0]) then dec(nb);
404     lastPt := curves[i][high(curves[i])];
405   end;
406   setlength(result,nb);
407   nb := 0;
408   for j := 0 to high(curves[0]) do
409     AddPt(curves[0][j]);
410   for i := 1 to high(curves) do
411   begin
412     if not EqLast(curves[i][0]) then AddPt(curves[i][0]);
413     for j := 1 to high(curves[i]) do
414       AddPt(curves[i][j]);
415   end;
416 end;
417 
ComputeBezierSplinenull418 function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve;
419   AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF;
420 var
421   curves: array of array of TPointF;
422   nb: integer;
423   lastPt: TPointF;
424   i: Integer;
425   j: Integer;
426 
427   procedure AddPt(pt: TPointF); inline;
428   begin
429     result[nb]:= pt;
430     inc(nb);
431     lastPt := pt;
432   end;
433 
EqLastnull434   function EqLast(pt: TPointF): boolean;
435   begin
436     result := (pt.x = lastPt.x) and (pt.y = lastPt.y);
437   end;
438 
439 begin
440   if length(spline)= 0 then
441   begin
442     setlength(result,0);
443     exit;
444   end;
445   setlength(curves, length(spline));
446   for i := 0 to high(spline) do
447     curves[i] := ComputeBezierCurve(spline[i],AAcceptedDeviation);
448   nb := length(curves[0]);
449   lastPt := curves[0][high(curves[0])];
450   for i := 1 to high(curves) do
451   begin
452     inc(nb,length(curves[i]));
453     if EqLast(curves[i][0]) then dec(nb);
454     lastPt := curves[i][high(curves[i])];
455   end;
456   setlength(result,nb);
457   nb := 0;
458   for j := 0 to high(curves[0]) do
459     AddPt(curves[0][j]);
460   for i := 1 to high(curves) do
461   begin
462     if not EqLast(curves[i][0]) then AddPt(curves[i][0]);
463     for j := 1 to high(curves[i]) do
464       AddPt(curves[i][j]);
465   end;
466 end;
467 
InternalComputeClosedSplinenull468 function InternalComputeClosedSpline(const APoints: array of TPointF; AStart, ACount: integer; AStyle: TSplineStyle; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF;
469 var
470   i, j, nb, idx, pre: integer;
471   ptPrev, ptPrev2, ptNext, ptNext2: TPointF;
472   t: single;
473   kernel: TWideKernelFilter;
474 
475 begin
476   if AStyle = ssEasyBezier then
477   begin
478     result := ComputeEasyBezier(EasyBezierCurve(APoints, AStart, ACount, true, cmCurve));
479     exit;
480   end;
481 
482   if ACount <= 2 then
483   begin
484     setlength(result, ACount);
485     for i := 0 to high(result) do
486       result[i] := APoints[AStart + i];
487     exit;
488   end;
489 
490   nb := 1;
491   for i := 0 to ACount-1 do
492   begin
493     ptPrev2 := APoints[(i + ACount - 1) mod ACount + AStart];
494     ptPrev  := APoints[i + AStart];
495     ptNext  := APoints[(i + 1) mod ACount + AStart];
496     ptNext2 := APoints[(i + 2) mod ACount + AStart];
497     inc(nb, ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation) );
498   end;
499 
500   kernel := CreateInterpolator(AStyle);
501   setlength(Result, nb);
502   idx := 0;
503   for i := 0 to ACount-1 do
504   begin
505     ptPrev2 := APoints[(i + ACount - 1) mod ACount + AStart];
506     ptPrev  := APoints[i+ AStart];
507     ptNext  := APoints[(i + 1) mod ACount + AStart];
508     ptNext2 := APoints[(i + 2) mod ACount + AStart];
509     pre     := ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation);
510     if i=0 then
511       j := 0
512     else
513       j := 1;
514     while j <= pre do
515     begin
516       t := j/pre;
517       result[idx] := ptPrev2*kernel.Interpolation(t+1) + ptPrev*kernel.Interpolation(t) +
518                      ptNext*kernel.Interpolation(t-1)  + ptNext2*kernel.Interpolation(t-2);
519       Inc(idx);
520       inc(j);
521     end;
522   end;
523   kernel.Free;
524 end;
525 
ComputeClosedSplinenull526 function ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF;
527 var
528   nbParts, partIndex, start, i: integer;
529   parts: array of array of TPointF;
530 begin
531   nbParts := 1;
532   for i := 0 to high(APoints) do
533     if isEmptyPointF(APoints[i]) then inc(nbParts);
534   if nbParts = 1 then
535     exit(InternalComputeClosedSpline(APoints, 0, length(APoints), AStyle, AAcceptedDeviation));
536   setlength(parts, nbParts);
537   partIndex := 0;
538   start := 0;
539   for i := 0 to high(APoints) do
540     if isEmptyPointF(APoints[i]) then
541     begin
542       parts[partIndex] := InternalComputeClosedSpline(APoints, start, i-start, AStyle, AAcceptedDeviation);
543       inc(partIndex);
544       start := i+1;
545     end;
546   parts[partIndex] := InternalComputeClosedSpline(APoints, start, length(APoints)-start, AStyle, AAcceptedDeviation);
547   result := ConcatPointsF(parts, true);
548 end;
549 
InternalComputeOpenedSplinenull550 function InternalComputeOpenedSpline(const APoints: array of TPointF; AStart, ACount: integer; AStyle: TSplineStyle; AEndCoeff: single; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF;
551 var
552   i, j, nb, idx, pre: integer;
553   ptPrev, ptPrev2, ptNext, ptNext2: TPointF;
554   t: single;
555   kernel: TWideKernelFilter;
556 begin
557   if AStyle = ssEasyBezier then
558   begin
559     result := ComputeEasyBezier(EasyBezierCurve(APoints, AStart, ACount, false, cmCurve));
560     exit;
561   end;
562 
563   if ACount <= 2 then
564   begin
565     setlength(result, ACount);
566     for i := 0 to high(result) do
567       result[i] := APoints[AStart + i];
568     exit;
569   end;
570   if AStyle in[ssInsideWithEnds,ssCrossingWithEnds] then AEndCoeff := 0;
571   if AEndCoeff < -0.3 then AEndCoeff := -0.3;
572 
573   nb := 1;
574   for i := 0 to ACount - 2 do
575   begin
576     ptPrev  := APoints[AStart + i];
577     ptNext  := APoints[AStart + i + 1];
578     if i=0 then
579       ptPrev2 := (ptPrev+(ptNext+APoints[AStart + i + 2])*AEndCoeff)*(1/(1+2*AEndCoeff))
580     else
581       ptPrev2 := APoints[AStart + i - 1];
582     if i = ACount - 2 then
583       ptNext2 := (ptNext+(ptPrev+APoints[AStart + i - 1])*AEndCoeff)*(1/(1+2*AEndCoeff))
584     else
585       ptNext2 := APoints[AStart + i + 2];
586     inc(nb, ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation) );
587   end;
588 
589   kernel := CreateInterpolator(AStyle);
590   if AStyle in[ssInsideWithEnds,ssCrossingWithEnds] then
591   begin
592     inc(nb,2);
593     setlength(Result, nb);
594     result[0] := APoints[AStart];
595     idx := 1;
596   end else
597   begin
598     idx := 0;
599     setlength(Result, nb);
600   end;
601   for i := 0 to ACount - 2 do
602   begin
603     ptPrev  := APoints[AStart + i];
604     ptNext  := APoints[AStart + i + 1];
605     if i=0 then
606       ptPrev2 := (ptPrev+(ptNext+APoints[i + 2 + AStart])*AEndCoeff)*(1/(1+2*AEndCoeff))
607     else
608       ptPrev2 := APoints[AStart + i - 1];
609     if i = ACount - 2 then
610       ptNext2 := (ptNext+(ptPrev+APoints[i - 1 + AStart])*AEndCoeff)*(1/(1+2*AEndCoeff))
611     else
612       ptNext2 := APoints[AStart + i + 2];
613     pre     := ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation);
614     if i=0 then
615     begin
616       j := 0;
617     end else j := 1;
618     while j <= pre do
619     begin
620       t := j/pre;
621       result[idx] := ptPrev2*kernel.Interpolation(t+1) + ptPrev*kernel.Interpolation(t) +
622                      ptNext*kernel.Interpolation(t-1)  + ptNext2*kernel.Interpolation(t-2);
623       Inc(idx);
624       inc(j);
625     end;
626   end;
627   kernel.Free;
628   if AStyle in[ssInsideWithEnds,ssCrossingWithEnds] then
629     result[idx] := APoints[AStart + ACount - 1];
630 end;
631 
ComputeClosedSplinenull632 function ComputeClosedSpline(const APoints: array of TPointF; AStart,
633   ACount: integer; AStyle: TSplineStyle; AAcceptedDeviation: single): ArrayOfTPointF;
634 var
635   i: Integer;
636 begin
637   if (AStart < 0) or (AStart + ACount > length(APoints)) then
638     raise exception.Create('Index out of bounds');
639   for i := 0 to ACount-1 do
640     if IsEmptyPointF(APoints[AStart + i]) then
641       raise exception.Create('Unexpected empty point');
642   result := InternalComputeClosedSpline(APoints, AStart, ACount, AStyle, AAcceptedDeviation);
643 end;
644 
ComputeOpenedSplinenull645 function ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle; AEndCoeff: single; AAcceptedDeviation: single = DefaultDeviation): ArrayOfTPointF;
646 var
647   nbParts, partIndex, start, i: integer;
648   parts: array of array of TPointF;
649 begin
650   nbParts := 1;
651   for i := 0 to high(APoints) do
652     if isEmptyPointF(APoints[i]) then inc(nbParts);
653   if nbParts = 1 then
654     exit(InternalComputeOpenedSpline(APoints, 0, length(APoints), AStyle, AEndCoeff, AAcceptedDeviation));
655   setlength(parts, nbParts);
656   partIndex := 0;
657   start := 0;
658   for i := 0 to high(APoints) do
659     if isEmptyPointF(APoints[i]) then
660     begin
661       parts[partIndex] := InternalComputeOpenedSpline(APoints, start, i-start, AStyle, AEndCoeff, AAcceptedDeviation);
662       inc(partIndex);
663       start := i+1;
664     end;
665   parts[partIndex] := InternalComputeOpenedSpline(APoints, start, length(APoints)-start, AStyle, AEndCoeff, AAcceptedDeviation);
666   result := ConcatPointsF(parts, true);
667 end;
668 
ComputeOpenedSplinenull669 function ComputeOpenedSpline(const APoints: array of TPointF; AStart,
670   ACount: integer; AStyle: TSplineStyle; AEndCoeff: single;
671   AAcceptedDeviation: single): ArrayOfTPointF;
672 var
673   i: Integer;
674 begin
675   if (AStart < 0) or (AStart + ACount > length(APoints)) then
676     raise exception.Create('Index out of bounds');
677   for i := 0 to ACount-1 do
678     if IsEmptyPointF(APoints[AStart + i]) then
679       raise exception.Create('Unexpected empty point');
680   result := InternalComputeOpenedSpline(APoints, AStart, ACount, AStyle, AEndCoeff, AAcceptedDeviation);
681 end;
682 
ClosedSplineStartPointnull683 function ClosedSplineStartPoint(const points: array of TPointF;
684   Style: TSplineStyle): TPointF;
685 var
686   kernel: TWideKernelFilter;
687   ptPrev2: TPointF;
688   ptPrev: TPointF;
689   ptNext: TPointF;
690   ptNext2: TPointF;
691 begin
692   if Style = ssEasyBezier then
693   begin
694     result := EasyBezierCurve(points, true, cmCurve).CurveStartPoint;
695   end else
696   begin
697     if length(points) = 0 then
698       result := EmptyPointF
699     else
700     if length(points)<=2 then
701       result := points[0]
702     else
703     begin
704       kernel := CreateInterpolator(style);
705       ptPrev2 := points[high(points)];
706       ptPrev  := points[0];
707       ptNext  := points[1];
708       ptNext2 := points[2];
709       result := ptPrev2*kernel.Interpolation(1) + ptPrev*kernel.Interpolation(0) +
710                 ptNext*kernel.Interpolation(-1)  + ptNext2*kernel.Interpolation(-2);
711       kernel.free;
712     end;
713   end;
714 end;
715 
ComputeEasyBeziernull716 function ComputeEasyBezier(const curve: TEasyBezierCurve;
717   AAcceptedDeviation: single): ArrayOfTPointF;
718 var
719   path: TBGRAPath;
720 begin
721   path := TBGRAPath.Create;
722   curve.CopyToPath(path);
723   result := path.ToPoints(AAcceptedDeviation);
724   path.Free;
725 end;
726 
ComputeArc65536null727 function ComputeArc65536(x, y, rx, ry: single; start65536,end65536: word; quality: single): ArrayOfTPointF;
728 var i,nb: integer;
729     arclen: integer;
730     pos: word;
731 begin
732   if end65536 > start65536 then
733     arclen := end65536-start65536 else
734     arclen := 65536-(start65536-end65536);
735 
736   if quality < 0 then quality := 0;
737 
738   nb := round(((rx+ry)*2*quality+8)*arclen/65536) and not 3;
739   if arclen <= 16384 then
740   begin
741     if nb < 2 then nb := 2;
742   end else
743   if arclen <= 32768 then
744   begin
745     if nb < 3 then nb := 3;
746   end else
747   if arclen <= 32768+16384 then
748   begin
749     if nb < 4 then nb := 4;
750   end else
751     if nb < 5 then nb := 5;
752 
753   if nb > arclen+1 then nb := arclen+1;
754 
755   setlength(result,nb);
756   for i := 0 to nb-1 do
757   begin
758     {$PUSH}{$R-}
759     pos := start65536+int64(i)*arclen div (int64(nb)-1);
760     {$POP}
761     result[i] := PointF(x+rx*(Cos65536(pos)-32768)/32768,
762                         y-ry*(Sin65536(pos)-32768)/32768);
763   end;
764 end;
765 
ComputeEllipsenull766 function ComputeEllipse(x, y, rx, ry: single; quality: single): ArrayOfTPointF;
767 begin
768   result := ComputeArc65536(x,y,rx,ry,0,0,quality);
769 end;
770 
ComputeEllipsenull771 function ComputeEllipse(AOrigin, AXAxis, AYAxis: TPointF; quality: single): ArrayOfTPointF;
772 begin
773   result := ComputeArcRad(AOrigin, AXAxis, AYAxis, 0,0, quality);
774 end;
775 
ComputeArc65536null776 function ComputeArc65536(AOrigin, AXAxis, AYAxis: TPointF; start65536,
777   end65536: word; quality: single): ArrayOfTPointF;
778 begin
779   //go back temporarily to radians
780   result := ComputeArcRad(AOrigin,AXAxis,AYAxis, start65536*Pi/326768, end65536*Pi/326768, quality);
781 end;
782 
ComputeArcRadnull783 function ComputeArcRad(x, y, rx, ry: single; startRadCCW, endRadCCW: single;
784   quality: single): ArrayOfTPointF;
785 var
786   start65536, end65536: Int64;
787 begin
788   start65536 := round(startRadCCW*32768/Pi);
789   end65536 := round(endRadCCW*32768/Pi);
790   //if arc is very small but non zero, it is not a circle
791   if (start65536 = end65536) and (startRadCCW <> endRadCCW) then
792     setlength(result,2) else
793     result := ComputeArc65536(x,y,rx,ry,start65536 and $ffff,end65536 and $ffff,quality);
794   result[0] := PointF(x+cos(startRadCCW)*rx,y-sin(startRadCCW)*ry);
795   result[high(result)] := PointF(x+cos(endRadCCW)*rx,y-sin(endRadCCW)*ry);
796 end;
797 
ComputeArcRadnull798 function ComputeArcRad(AOrigin, AXAxis, AYAxis: TPointF; startRadCCW,endRadCCW: single; quality: single): ArrayOfTPointF;
799 var
800   u, v: TPointF;
801   lenU, lenV: Single;
802   m: TAffineMatrix;
803   i: Integer;
804 begin
805   u := AXAxis-AOrigin;
806   lenU := VectLen(u);
807   v := AYAxis-AOrigin;
808   lenV := VectLen(v);
809   if (lenU = 0) and (lenV = 0) then exit(PointsF([AOrigin]));
810 
811   result := ComputeArcRad(0, 0, lenU, lenV, startRadCCW, endRadCCW, quality);
812 
813   if lenU <> 0 then u.Scale(1/lenU);
814   if lenV <> 0 then v.Scale(1/lenV);
815   m := AffineMatrix(u, v, AOrigin);
816   for i := 0 to high(result) do
817     result[i] := m*result[i];
818 end;
819 
ComputeArcnull820 function ComputeArc(const arc: TArcDef; quality: single): ArrayOfTPointF;
821 var startAngle,endAngle: single;
822     i,n: integer;
823     temp: TPointF;
824     m: TAffineMatrix;
825 begin
826   startAngle := -arc.startAngleRadCW;
827   endAngle:= -arc.endAngleRadCW;
828   if not arc.anticlockwise then
829   begin
830     result := ComputeArcRad(arc.center.x,arc.center.y,arc.radius.x,arc.radius.y,endAngle,startAngle,quality);
831     n := length(result);
832     if n>1 then
833       for i := 0 to (n-2) div 2 do
834       begin
835         temp := result[i];
836         result[i] := result[n-1-i];
837         result[n-1-i] := temp;
838       end;
839   end else
840     result := ComputeArcRad(arc.center.x,arc.center.y,arc.radius.x,arc.radius.y,startAngle,endAngle,quality);
841   if arc.xAngleRadCW <> 0 then
842   begin
843     m := AffineMatrixTranslation(arc.center.x,arc.center.y)*AffineMatrixRotationRad(-arc.xAngleRadCW)*AffineMatrixTranslation(-arc.center.x,-arc.center.y);
844     for i := 0 to high(result) do
845       result[i] := m*result[i];
846   end;
847 end;
848 
ComputeRoundRectnull849 function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; quality: single): ArrayOfTPointF;
850 begin
851   result := ComputeRoundRect(x1,y1,x2,y2,rx,ry,[],quality);
852 end;
853 
ComputeRoundRectnull854 function ComputeRoundRect(x1, y1, x2, y2, rx, ry: single;
855   options: TRoundRectangleOptions; quality: single): ArrayOfTPointF;
856 var q0,q1,q2,q3,q4: array of TPointF;
857   temp: Single;
858 begin
859   if x1 > x2 then
860   begin
861     temp := x1;
862     x1 := x2;
863     x2 := temp;
864   end;
865   if y1 > y2 then
866   begin
867     temp := y1;
868     y1 := y2;
869     y2 := temp;
870   end;
871   rx := abs(rx);
872   ry := abs(ry);
873   if 2*rx > x2-x1 then
874     rx := (x2-x1)/2;
875   if 2*ry > y2-y1 then
876     ry := (y2-y1)/2;
877 
878   q0 := PointsF([PointF(x2,(y1+y2)/2)]);
879 
880   if rrTopRightBevel in options then
881     q1 := PointsF([PointF(x2,y1+ry),PointF(x2-rx,y1)]) else
882   if rrTopRightSquare in options then
883     q1 := PointsF([PointF(x2,y1)])
884   else
885     q1 := ComputeArc65536(x2-rx,y1+ry,rx,ry,0,16384,quality);
886 
887   if rrTopLeftBevel in options then
888     q2 := PointsF([PointF(x1+rx,y1),PointF(x1,y1+ry)]) else
889   if rrTopLeftSquare in options then
890     q2 := PointsF([PointF(x1,y1)])
891   else
892     q2 := ComputeArc65536(x1+rx,y1+ry,rx,ry,16384,32768,quality);
893 
894   if rrBottomLeftBevel in options then
895     q3 := PointsF([PointF(x1,y2-ry),PointF(x1+rx,y2)]) else
896   if rrBottomLeftSquare in options then
897     q3 := PointsF([PointF(x1,y2)])
898   else
899     q3 := ComputeArc65536(x1+rx,y2-ry,rx,ry,32768,32768+16384,quality);
900 
901   if rrBottomRightBevel in options then
902     q4 := PointsF([PointF(x2-rx,y2),PointF(x2,y2-ry)]) else
903   if rrBottomRightSquare in options then
904     q4 := PointsF([PointF(x2,y2)])
905   else
906     q4 := ComputeArc65536(x2-rx,y2-ry,rx,ry,32768+16384,0,quality);
907 
908   result := ConcatPointsF([q0,q1,q2,q3,q4]);
909 end;
910 
Html5ArcTonull911 function Html5ArcTo(const p0, p1, p2: TPointF; radius: single
912   ): TArcDef;
913 var p3,p4,an,bn,cn,c: TPointF;
914     dir, a2, b2, c2, cosx, sinx, d: single;
915     anticlockwise: boolean;
916 begin
917   result.center := p1;
918   result.radius := PointF(0,0);
919   result.xAngleRadCW:= 0;
920   result.startAngleRadCW := 0;
921   result.endAngleRadCW:= 0;
922   result.anticlockwise:= false;
923 
924   radius := abs(radius);
925   if (p0 = p1) or (p1 = p2) or (radius = 0) then exit;
926 
927   dir := (p2.x-p1.x)*(p0.y-p1.y) + (p2.y-p1.y)*(p1.x-p0.x);
928   if dir = 0 then exit;
929 
930   a2 := (p0.x-p1.x)*(p0.x-p1.x) + (p0.y-p1.y)*(p0.y-p1.y);
931   b2 := (p1.x-p2.x)*(p1.x-p2.x) + (p1.y-p2.y)*(p1.y-p2.y);
932   c2 := (p0.x-p2.x)*(p0.x-p2.x) + (p0.y-p2.y)*(p0.y-p2.y);
933   cosx := (a2+b2-c2)/(2*sqrt(a2*b2));
934 
935   sinx := sqrt(1 - cosx*cosx);
936   if (sinx = 0) or (cosx = 1) then exit;
937   d := radius / ((1 - cosx) / sinx);
938 
939   an := (p1-p0)*(1/sqrt(a2));
940   bn := (p1-p2)*(1/sqrt(b2));
941   p3 := p1 - an*d;
942   p4 := p1 - bn*d;
943   anticlockwise := (dir < 0);
944 
945   cn := PointF(an.y,-an.x)*radius;
946   if not anticlockwise then cn := -cn;
947   c := p3 + cn;
948 
949   result.center := c;
950   result.radius:= PointF(radius,radius);
951   result.startAngleRadCW := arctan2((p3.y-c.y), (p3.x-c.x));
952   result.endAngleRadCW := arctan2((p4.y-c.y), (p4.x-c.x));
953   result.anticlockwise:= anticlockwise;
954 end;
955 
SvgArcTonull956 function SvgArcTo(const p0: TPointF; rx, ry, xAngleRadCW: single; largeArc,
957   anticlockwise: boolean; const p1: TPointF): TArcDef;
958 var
959     p0p,cp: TPointF;
960     cross1,cross2,lambda: single;
961 begin
962   if (rx=0) or (ry=0) or (p0 = p1) then
963   begin
964     result.radius := PointF(0,0);
965     result.xAngleRadCW:= 0;
966     result.anticlockwise := false;
967     result.endAngleRadCW := 0;
968     result.startAngleRadCW:= 0;
969     result.center := p1;
970     exit;
971   end;
972   result.xAngleRadCW := xAngleRadCW;
973   result.anticlockwise := anticlockwise;
974   p0p := AffineMatrixRotationRad(xAngleRadCW)*( (p0-p1)*0.5 );
975 
976   //ensure radius is big enough
977   lambda := sqr(p0p.x/rx) + sqr(p0p.y/ry);
978   if lambda > 1 then
979   begin
980     lambda := sqrt(lambda);
981     rx := rx * lambda;
982     ry := ry * lambda;
983   end;
984   result.radius := PointF(rx,ry);
985 
986   //compute center
987   cross2 := sqr(rx*p0p.y) + sqr(ry*p0p.x);
988   cross1 := sqr(rx*ry);
989   if cross1 <= cross2 then
990     cp := PointF(0,0)
991   else
992     cp := sqrt((cross1-cross2)/cross2)*
993        PointF(rx*p0p.y/ry, -ry*p0p.x/rx);
994   if largeArc <> anticlockwise then cp := -cp;
995 
996   result.center := AffineMatrixRotationRad(-xAngleRadCW)*cp +
997                   (p0+p1)*0.5;
998   result.startAngleRadCW := arctan2((p0p.y-cp.y)/ry,(p0p.x-cp.x)/rx);
999   result.endAngleRadCW := arctan2((-p0p.y-cp.y)/ry,(-p0p.x-cp.x)/rx);
1000 end;
1001 
ArcStartPointnull1002 function ArcStartPoint(const arc: TArcDef): TPointF;
1003 begin
1004   result := AffineMatrixRotationRad(-arc.xAngleRadCW)*PointF(cos(arc.startAngleRadCW)*arc.radius.x,
1005                                                        sin(arc.startAngleRadCW)*arc.radius.y) + arc.center;
1006 end;
1007 
ArcEndPointnull1008 function ArcEndPoint(const arc: TArcDef): TPointF;
1009 begin
1010   result := AffineMatrixRotationRad(-arc.xAngleRadCW)*PointF(cos(arc.endAngleRadCW)*arc.radius.x,
1011                                                        sin(arc.endAngleRadCW)*arc.radius.y) + arc.center;
1012 end;
1013 
IsLargeArcnull1014 function IsLargeArc(const arc: TArcDef): boolean;
1015 var diff,a1,a2: single;
1016 begin
1017   a1 := arc.startAngleRadCW - floor(arc.startAngleRadCW/(2*Pi))*(2*Pi);
1018   a2 := arc.endAngleRadCW - floor(arc.endAngleRadCW/(2*Pi))*(2*Pi);
1019   if not arc.anticlockwise then
1020     diff := a2 - a1
1021   else
1022     diff := a1 - a2;
1023   result := (diff < 0) or (diff >= Pi);
1024 end;
1025 
1026 { TBGRAPathCursor }
1027 
GetCurrentCoordnull1028 function TBGRAPathCursor.GetCurrentCoord: TPointF;
1029 begin
1030   case FCurrentElementType of
1031     peNone: result := EmptyPointF;
1032     peMoveTo,peLineTo,peCloseSubPath:
1033       if FCurrentElementLength <= 0 then
1034         result := FCurrentElementStartCoord
1035       else
1036         result := FCurrentElementStartCoord + (FCurrentElementEndCoord-FCurrentElementStartCoord)*(FCurrentElementArcPos/FCurrentElementLength);
1037     peCubicBezierTo,peQuadraticBezierTo,peArc,peOpenedSpline,peClosedSpline:
1038       begin
1039         NeedPolygonalApprox;
1040         if FCurrentSegment >= high(FCurrentElementPoints) then
1041           result := FCurrentElementEndCoord
1042         else
1043           result := FCurrentElementPoints[FCurrentSegment]+
1044           (FCurrentElementPoints[FCurrentSegment+1]-
1045            FCurrentElementPoints[FCurrentSegment])*FCurrentSegmentPos;
1046       end;
1047     else
1048       raise Exception.Create('Unknown element type');
1049   end;
1050 end;
1051 
GetPathnull1052 function TBGRAPathCursor.GetPath: TBGRAPath;
1053 begin
1054   if not Assigned(FPath) then
1055     raise exception.Create('Path does not exist');
1056   result := FPath;
1057 end;
1058 
1059 procedure TBGRAPathCursor.MoveToEndOfElement;
1060 begin
1061   FCurrentElementArcPos := FCurrentElementLength;
1062   if not NeedPolygonalApprox then exit;
1063   if length(FCurrentElementPoints) > 1 then
1064   begin
1065     FCurrentSegment := high(FCurrentElementPoints)-1;
1066     FCurrentSegmentPos := 1;
1067   end else
1068   begin
1069     FCurrentSegment := high(FCurrentElementPoints);
1070     FCurrentSegmentPos := 0;
1071   end;
1072 end;
1073 
1074 procedure TBGRAPathCursor.MoveForwardInElement(ADistance: single);
1075 var segLen,rightSpace,remaining: single;
1076 begin
1077   if not NeedPolygonalApprox then exit;
1078   ADistance := ADistance * FCurrentElementArcPosScale;
1079   remaining := ADistance;
1080   while remaining > 0 do
1081   begin
1082     if FCurrentSegment < high(FCurrentElementPoints) then
1083       segLen := VectLen(FCurrentElementPoints[FCurrentSegment+1]-FCurrentElementPoints[FCurrentSegment])
1084     else
1085       segLen := 0;
1086     rightSpace := segLen*(1-FCurrentSegmentPos);
1087     if (segLen > 0) and (remaining <= rightSpace) then
1088     begin
1089       IncF(FCurrentSegmentPos, remaining/segLen);
1090       exit;
1091     end else
1092     begin
1093       DecF(remaining, rightSpace);
1094       if FCurrentSegment < high(FCurrentElementPoints)-1 then
1095       begin
1096         inc(FCurrentSegment);
1097         FCurrentSegmentPos := 0;
1098       end else
1099       begin
1100         FCurrentSegmentPos := 1;
1101         exit;
1102       end;
1103     end;
1104   end;
1105 end;
1106 
1107 procedure TBGRAPathCursor.MoveBackwardInElement(ADistance: single);
1108 var
1109   segLen,leftSpace,remaining: Single;
1110 begin
1111   if not NeedPolygonalApprox then exit;
1112   ADistance := ADistance * FCurrentElementArcPosScale;
1113   remaining := ADistance;
1114   while remaining > 0 do
1115   begin
1116     if FCurrentSegment < high(FCurrentElementPoints) then
1117       segLen := VectLen(FCurrentElementPoints[FCurrentSegment+1]-FCurrentElementPoints[FCurrentSegment])
1118     else
1119       segLen := 0;
1120     leftSpace := segLen*FCurrentSegmentPos;
1121     if (segLen > 0) and (remaining <= leftSpace) then
1122     begin
1123       DecF(FCurrentSegmentPos, remaining/segLen);
1124       exit;
1125     end else
1126     begin
1127       DecF(remaining, leftSpace);
1128       if FCurrentSegment > 0 then
1129       begin
1130         dec(FCurrentSegment);
1131         FCurrentSegmentPos := 1;
1132       end else
1133       begin
1134         FCurrentSegmentPos := 0;
1135         exit;
1136       end;
1137     end;
1138   end;
1139 end;
1140 
NeedPolygonalApproxnull1141 function TBGRAPathCursor.NeedPolygonalApprox: boolean;
1142 begin
1143   if not (FCurrentElementType in[peQuadraticBezierTo,peCubicBezierTo,peArc,
1144   peOpenedSpline,peClosedSpline])
1145   then
1146   begin
1147     result := false;
1148     exit;
1149   end;
1150   result := true;
1151   if FCurrentElementPoints = nil then
1152   begin
1153     FCurrentElementPoints := Path.GetPolygonalApprox(FDataPos, FAcceptedDeviation, True);
1154     if FCurrentElementType = peQuadraticBezierTo then
1155     begin
1156       if FCurrentElementLength <> 0 then
1157         FCurrentElementArcPosScale := PolylineLen(FCurrentElementPoints)/FCurrentElementLength;
1158     end;
1159   end;
1160 end;
1161 
TBGRAPathCursor.GetArcPosnull1162 function TBGRAPathCursor.GetArcPos: single;
1163 var pos: PtrInt;
1164 begin
1165   if FArcPos = EmptySingle then
1166   begin
1167     FArcPos := FCurrentElementArcPos;
1168     pos := FDataPos;
1169     while Path.GoToPreviousElement(pos) do
1170       IncF(FArcPos, Path.GetElementLength(pos, FAcceptedDeviation));
1171   end;
1172   result := FArcPos;
1173 end;
1174 
TBGRAPathCursor.GetCurrentTangentnull1175 function TBGRAPathCursor.GetCurrentTangent: TPointF;
1176 var idxStart,idxEnd: integer;
1177   seg: TPointF;
1178 begin
1179   while FCurrentElementLength <= 0 do
1180   begin
1181     if not GoToNextElement(False) then
1182     begin
1183       result := EmptyPointF;
1184       exit;
1185     end;
1186   end;
1187   case FCurrentElementType of
1188     peMoveTo,peLineTo,peCloseSubPath:
1189       result := (FCurrentElementEndCoord-FCurrentElementStartCoord)*(1/FCurrentElementLength);
1190     peCubicBezierTo,peQuadraticBezierTo,peArc,peOpenedSpline,peClosedSpline:
1191       begin
1192         NeedPolygonalApprox;
1193         idxStart := FCurrentSegment;
1194         if idxStart >= high(FCurrentElementPoints) then
1195           idxStart:= high(FCurrentElementPoints)-1;
1196         idxEnd := idxStart+1;
1197         if idxStart < 0 then
1198         begin
1199           result := EmptyPointF;
1200           exit;
1201         end;
1202         seg := FCurrentElementPoints[idxEnd] - FCurrentElementPoints[idxStart];
1203         while (seg.x = 0) and (seg.y = 0) and (idxEnd < high(FCurrentElementPoints)) do
1204         begin
1205           inc(idxEnd);
1206           seg := FCurrentElementPoints[idxEnd] - FCurrentElementPoints[idxStart];
1207         end;
1208         while (seg.x = 0) and (seg.y = 0) and (idxStart > 0) do
1209         begin
1210           dec(idxStart);
1211           seg := FCurrentElementPoints[idxEnd] - FCurrentElementPoints[idxStart];
1212         end;
1213         if (seg.x = 0) and (seg.y = 0) then
1214           result := EmptyPointF
1215         else
1216           result := seg*(1/VectLen(seg));
1217       end;
1218     else result := EmptyPointF;
1219   end;
1220 end;
1221 
1222 procedure TBGRAPathCursor.SetArcPos(AValue: single);
1223 var oldLoopClosedShapes,oldLoopPath: boolean;
1224 begin
1225   if GetArcPos=AValue then Exit;
1226   if (AValue > PathLength) and (PathLength <> 0) then
1227     AValue := AValue - trunc(AValue/PathLength)*PathLength
1228   else if (AValue < 0) then
1229     AValue := AValue + (trunc(-AValue/PathLength)+1)*PathLength;
1230   oldLoopClosedShapes:= LoopClosedShapes;
1231   oldLoopPath:= LoopPath;
1232   LoopClosedShapes:= false;
1233   LoopPath:= false;
1234   MoveForward(AValue-GetArcPos, True);
1235   LoopClosedShapes:= oldLoopClosedShapes;
1236   LoopPath:= oldLoopPath;
1237 end;
1238 
GetPathLengthnull1239 function TBGRAPathCursor.GetPathLength: single;
1240 begin
1241   if not FPathLengthComputed then
1242   begin
1243     FPathLength := Path.ComputeLength(FAcceptedDeviation);
1244     FPathLengthComputed := true;
1245   end;
1246   result := FPathLength;
1247 end;
1248 
1249 procedure TBGRAPathCursor.OnPathFree;
1250 begin
1251   FPath := nil;
1252 end;
1253 
TBGRAPathCursor.GetLoopClosedShapesnull1254 function TBGRAPathCursor.GetLoopClosedShapes: boolean;
1255 begin
1256   result := FLoopClosedShapes;
1257 end;
1258 
TBGRAPathCursor.GetLoopPathnull1259 function TBGRAPathCursor.GetLoopPath: boolean;
1260 begin
1261   result := FLoopPath;
1262 end;
1263 
GetStartCoordinatenull1264 function TBGRAPathCursor.GetStartCoordinate: TPointF;
1265 begin
1266   result := FStartCoordinate;
1267 end;
1268 
1269 procedure TBGRAPathCursor.SetLoopClosedShapes(AValue: boolean);
1270 begin
1271   FLoopClosedShapes := AValue;
1272 end;
1273 
1274 procedure TBGRAPathCursor.SetLoopPath(AValue: boolean);
1275 begin
1276   FLoopPath := AValue;
1277 end;
1278 
1279 procedure TBGRAPathCursor.PrepareCurrentElement;
1280 begin
1281   Path.GetElementAt(FDataPos, FCurrentElementType, FCurrentElement);
1282   FCurrentElementLength := 0;
1283   FCurrentElementArcPos := 0;
1284   FCurrentElementPoints := nil;
1285   FCurrentSegment := 0;
1286   FCurrentSegmentPos := 0;
1287   FCurrentElementArcPosScale := 1;
1288   if FCurrentElementType = peNone then
1289   begin
1290     FCurrentElementStartCoord := EmptyPointF;
1291     FCurrentElementEndCoord := EmptyPointF;
1292   end
1293   else
1294   begin
1295     FCurrentElementStartCoord := Path.GetElementStartCoord(FDataPos);
1296     case FCurrentElementType of
1297       peLineTo, peCloseSubPath:
1298         begin
1299           FCurrentElementEndCoord := PPointF(FCurrentElement)^;
1300           FCurrentElementLength := VectLen(FCurrentElementEndCoord - FCurrentElementStartCoord);
1301         end;
1302       peQuadraticBezierTo: with PQuadraticBezierToElement(FCurrentElement)^ do
1303         begin
1304           FCurrentElementEndCoord := Destination;
1305           FCurrentElementLength := BGRABitmapTypes.BezierCurve(FCurrentElementStartCoord,ControlPoint,Destination).ComputeLength;
1306         end;
1307       peCubicBezierTo,peArc,peOpenedSpline,peClosedSpline:
1308         begin
1309           NeedPolygonalApprox;
1310           FCurrentElementEndCoord := FCurrentElementPoints[high(FCurrentElementPoints)];
1311           FCurrentElementLength := PolylineLen(FCurrentElementPoints);
1312         end;
1313     else
1314       FCurrentElementEndCoord := FCurrentElementStartCoord;
1315     end;
1316   end;
1317 end;
1318 
TBGRAPathCursor.GetBoundsnull1319 function TBGRAPathCursor.GetBounds: TRectF;
1320 begin
1321   if not FBoundsComputed then
1322   begin
1323     FBounds:= Path.GetBounds(FAcceptedDeviation);
1324     FBoundsComputed := true;
1325   end;
1326   result := FBounds;
1327 end;
1328 
TBGRAPathCursor.GoToNextElementnull1329 function TBGRAPathCursor.GoToNextElement(ACanJump: boolean): boolean;
1330 begin
1331   if (FCurrentElementType = peCloseSubPath) and
1332    (PClosePathElement(FCurrentElement)^.LoopDataPos <> -1) and
1333    (  FLoopClosedShapes or
1334       (FLoopPath and (PClosePathElement(FCurrentElement)^.LoopDataPos = 0))
1335    ) then
1336   begin
1337     if PClosePathElement(FCurrentElement)^.LoopDataPos <> FDataPos then
1338     begin
1339       result := true;
1340       FDataPos := PClosePathElement(FCurrentElement)^.LoopDataPos;
1341       FArcPos := EmptySingle;
1342       PrepareCurrentElement;
1343     end else
1344       result := false;
1345   end;
1346   if not ACanJump and ((FCurrentElementType = peCloseSubPath)
1347    or (Path.PeekNextElement(FDataPos) = peMoveTo)) then
1348   begin
1349     result := false;
1350     exit;
1351   end;
1352   if Path.GoToNextElement(FDataPos) then
1353   begin
1354     result := true;
1355     PrepareCurrentElement;
1356   end
1357   else
1358   begin
1359     if ACanJump and FLoopPath and (FDataPos > 0) then
1360     begin
1361       result := true;
1362       FDataPos := 0;
1363       FArcPos := EmptySingle;
1364       PrepareCurrentElement;
1365     end else
1366       result := false;
1367   end;
1368 end;
1369 
TBGRAPathCursor.GoToPreviousElementnull1370 function TBGRAPathCursor.GoToPreviousElement(ACanJump: boolean): boolean;
1371 var lastElemPos: IntPtr;
1372 begin
1373   if (FCurrentElementType = peMoveTo) and (PMoveToElement(FCurrentElement)^.LoopDataPos <> -1) and
1374     ( FLoopClosedShapes or
1375       (FLoopPath and (FDataPos = 0))
1376     ) then
1377   with PMoveToElement(FCurrentElement)^ do
1378   begin
1379     if LoopDataPos <> -1 then
1380     begin
1381       result := true;
1382       FDataPos := LoopDataPos;
1383       FArcPos := EmptySingle;
1384       PrepareCurrentElement;
1385     end;
1386   end;
1387   if not ACanJump and (FCurrentElementType = peMoveTo) then
1388   begin
1389     result := false;
1390     exit;
1391   end;
1392   if Path.GoToPreviousElement(FDataPos) then
1393   begin
1394     result := true;
1395     PrepareCurrentElement;
1396   end
1397   else
1398   begin
1399     if FLoopPath then
1400     begin
1401       lastElemPos := FPath.FDataPos;
1402       if (lastElemPos > 0) and FPath.GoToPreviousElement(lastElemPos) then
1403       begin
1404         if lastElemPos > 0 then
1405         begin
1406           result := true;
1407           FDataPos := lastElemPos;
1408           PrepareCurrentElement;
1409           FArcPos := EmptySingle;
1410           exit;
1411         end;
1412       end;
1413     end;
1414     result := false;
1415   end;
1416 end;
1417 
1418 constructor TBGRAPathCursor.Create(APath: TBGRAPath; AAcceptedDeviation: single);
1419 begin
1420   FPath := APath;
1421   FPathLengthComputed := false;
1422   FBoundsComputed:= false;
1423   FDataPos := 0;
1424   FArcPos:= 0;
1425   FAcceptedDeviation:= AAcceptedDeviation;
1426   Path.RegisterCursor(self);
1427   PrepareCurrentElement;
1428 
1429   FStartCoordinate := FCurrentElementStartCoord;
1430   if isEmptyPointF(FStartCoordinate) then
1431     raise exception.Create('Path does not has a starting coordinate');
1432   FEndCoordinate := Path.FLastTransformedCoord;
1433   if isEmptyPointF(FEndCoordinate) then
1434     raise exception.Create('Path does not has an ending coordinate');
1435 end;
1436 
TBGRAPathCursor.MoveForwardnull1437 function TBGRAPathCursor.MoveForward(ADistance: single; ACanJump: boolean): single;
1438 var newArcPos,step,remaining: single;
1439 begin
1440   if ADistance < 0 then
1441   begin
1442     result := -MoveBackward(-ADistance, ACanJump);
1443     exit;
1444   end;
1445   result := 0;
1446   remaining := ADistance;
1447   while remaining > 0 do
1448   begin
1449     newArcPos := FCurrentElementArcPos + remaining;
1450     if newArcPos > FCurrentElementLength then
1451     begin
1452       step := FCurrentElementLength - FCurrentElementArcPos;
1453       IncF(result, step);
1454       DecF(remaining, step);
1455       if not GoToNextElement(ACanJump) then
1456       begin
1457         MoveForwardInElement(step);
1458         FCurrentElementArcPos := FCurrentElementLength;
1459         FArcPos := PathLength;
1460         exit;
1461       end;
1462     end else
1463     begin
1464       MoveForwardInElement(remaining);
1465       FCurrentElementArcPos := newArcPos;
1466       result := ADistance;
1467       break;
1468     end;
1469   end;
1470   if FArcPos <> EmptySingle then
1471     IncF(FArcPos, result);
1472 end;
1473 
MoveBackwardnull1474 function TBGRAPathCursor.MoveBackward(ADistance: single; ACanJump: boolean = true): single;
1475 var
1476   remaining: Single;
1477   newArcPos: Single;
1478   step: Single;
1479 begin
1480   if ADistance = 0 then
1481   begin
1482     result := 0;
1483     exit;
1484   end;
1485   if ADistance < 0 then
1486   begin
1487     result := -MoveForward(-ADistance, ACanJump);
1488     exit;
1489   end;
1490   result := 0;
1491   remaining := ADistance;
1492   while remaining > 0 do
1493   begin
1494     newArcPos := FCurrentElementArcPos - remaining;
1495     if newArcPos < 0 then
1496     begin
1497       step := FCurrentElementArcPos;
1498       IncF(result, step);
1499       DecF(remaining, step);
1500       if not GoToPreviousElement(ACanJump) then
1501       begin
1502         MoveBackwardInElement(step);
1503         FCurrentElementArcPos := 0;
1504         FArcPos := 0;
1505         exit;
1506       end else
1507         MoveToEndOfElement;
1508     end else
1509     begin
1510       MoveBackwardInElement(remaining);
1511       FCurrentElementArcPos := newArcPos;
1512       result := ADistance;
1513       break;
1514     end;
1515   end;
1516   if FArcPos <> EmptySingle then
1517     DecF(FArcPos, result);
1518 end;
1519 
1520 destructor TBGRAPathCursor.Destroy;
1521 begin
1522   if Assigned(FPath) then
1523   begin
1524     FPath.UnregisterCursor(self);
1525   end;
1526   inherited Destroy;
1527 end;
1528 
1529 { TBGRAPath }
1530 
TBGRAPath.ComputeLengthnull1531 function TBGRAPath.ComputeLength(AAcceptedDeviation: single): single;
1532 var pos: PtrInt;
1533 begin
1534   pos := 0;
1535   result := 0;
1536   repeat
1537     IncF(result, GetElementLength(pos, AAcceptedDeviation));
1538   until not GoToNextElement(pos);
1539 end;
1540 
ToPointsnull1541 function TBGRAPath.ToPoints(AAcceptedDeviation: single): ArrayOfTPointF;
1542 var sub: array of ArrayOfTPointF;
1543     temp: ArrayOfTPointF;
1544     nbSub,nbPts,curPt,curSub: Int32or64;
1545     startPos,pos: PtrInt;
1546     elemType: TBGRAPathElementType;
1547     elem: pointer;
1548 begin
1549   pos := 0;
1550   nbSub := 0;
1551   repeat
1552     GetElementAt(pos, elemType, elem);
1553     if elem = nil then break;
1554     case elemType of
1555       peMoveTo,peLineTo,peCloseSubPath: begin
1556           inc(nbSub);
1557           while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
1558             GoToNextElement(pos);
1559         end;
1560       peQuadraticBezierTo, peCubicBezierTo, peArc, peOpenedSpline, peClosedSpline: inc(nbSub);
1561     end;
1562   until not GoToNextElement(pos);
1563 
1564   pos := 0;
1565   setlength(sub, nbSub);
1566   curSub := 0;
1567   repeat
1568     GetElementAt(pos, elemType, elem);
1569     if elem = nil then break;
1570     case elemType of
1571       peMoveTo,peLineTo,peCloseSubPath: begin
1572           startPos := pos;
1573           if (elemType = peMoveTo) and (curSub > 0) then
1574             nbPts := 2
1575           else
1576             nbPts := 1;
1577           while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
1578           begin
1579             GoToNextElement(pos);
1580             inc(nbPts);
1581           end;
1582           setlength(temp, nbPts);
1583           pos := startPos;
1584           if (elemType = peMoveTo) and (curSub > 0) then
1585           begin
1586             temp[0] := EmptyPointF;
1587             temp[1] := PPointF(elem)^;
1588             curPt := 2;
1589           end else
1590           begin
1591             temp[0] := PPointF(elem)^;
1592             curPt := 1;
1593           end;
1594           while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
1595           begin
1596             GoToNextElement(pos);
1597             GetElementAt(pos, elemType, elem);
1598             temp[curPt] := PPointF(elem)^;
1599             inc(curPt);
1600           end;
1601           sub[curSub] := temp;
1602           inc(curSub);
1603           temp := nil;
1604         end;
1605       peQuadraticBezierTo,peCubicBezierTo,peArc,
1606       peOpenedSpline, peClosedSpline:
1607         begin
1608           sub[curSub] := GetPolygonalApprox(pos, AAcceptedDeviation, False);
1609           inc(curSub);
1610         end;
1611     end;
1612   until not GoToNextElement(pos) or (curSub = nbSub);
1613   result := ConcatPointsF(sub);
1614 end;
1615 
ToPointsnull1616 function TBGRAPath.ToPoints(AMatrix: TAffineMatrix; AAcceptedDeviation: single): ArrayOfTPointF;
1617 begin
1618   AAcceptedDeviation:= CorrectAcceptedDeviation(AAcceptedDeviation,AMatrix);
1619   result := ToPoints(AAcceptedDeviation);
1620   if not IsAffineMatrixIdentity(AMatrix) then
1621     result := AMatrix*result;
1622 end;
1623 
IsEmptynull1624 function TBGRAPath.IsEmpty: boolean;
1625 begin
1626   result := FDataPos = 0;
1627 end;
1628 
GetBoundsnull1629 function TBGRAPath.GetBounds(AAcceptedDeviation: single): TRectF;
1630 var empty: boolean;
1631     pos: PtrInt;
1632     elemType: TBGRAPathElementType;
1633     elem: pointer;
1634     temp: array of TPointF;
1635     i: integer;
1636 
1637   procedure Include(pt: TPointF);
1638   begin
1639     if empty then
1640     begin
1641       result.TopLeft := pt;
1642       result.BottomRight := pt;
1643       empty := false;
1644     end else
1645     begin
1646       if pt.x < result.Left then result.Left := pt.x
1647       else if pt.x > result.Right then result.Right := pt.x;
1648       if pt.y < result.Top then result.Top := pt.y
1649       else if pt.y > result.Bottom then result.Bottom := pt.y;
1650     end;
1651   end;
1652 
1653   procedure IncludeRect(r: TRectF);
1654   begin
1655     Include(r.TopLeft);
1656     Include(r.BottomRight);
1657   end;
1658 
1659 begin
1660   empty := true;
1661   result := RectF(0,0,0,0);
1662   pos := 0;
1663   repeat
1664     GetElementAt(pos, elemType, elem);
1665     if elem = nil then break;
1666     case elemType of
1667       peMoveTo,peLineTo,peCloseSubPath: begin
1668           Include(PPointF(elem)^);
1669           while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
1670           begin
1671             GoToNextElement(pos);
1672             GetElementAt(pos, elemType, elem);
1673             Include(PPointF(elem)^);
1674           end;
1675         end;
1676       peCubicBezierTo:
1677         with PCubicBezierToElement(elem)^ do
1678           IncludeRect(BGRABitmapTypes.BezierCurve(GetElementStartCoord(pos),ControlPoint1,ControlPoint2,Destination).GetBounds);
1679       peQuadraticBezierTo:
1680         with PQuadraticBezierToElement(elem)^ do
1681           IncludeRect(BGRABitmapTypes.BezierCurve(GetElementStartCoord(pos),ControlPoint,Destination).GetBounds);
1682       peArc, peOpenedSpline, peClosedSpline:
1683         begin
1684           temp := GetPolygonalApprox(pos, AAcceptedDeviation, False);
1685           for i := 0 to high(temp) do
1686             Include(temp[i]);
1687         end;
1688     end;
1689   until not GoToNextElement(pos);
1690   if empty then raise exception.Create('Path is empty');
1691 end;
1692 
1693 procedure TBGRAPath.SetPoints(const APoints: ArrayOfTPointF);
1694 var i: integer;
1695     nextIsMoveTo: boolean;
1696     startPoint: TPointF;
1697 begin
1698   beginPath;
1699   if length(APoints) = 0 then exit;
1700   NeedSpace((sizeof(TPathElementHeader)+sizeof(TPointF))*length(APoints));
1701   nextIsMoveTo:= true;
1702   startPoint := EmptyPointF;
1703   for i := 0 to high(APoints) do
1704   begin
1705     if isEmptyPointF(APoints[i]) then
1706       nextIsMoveTo:= true
1707     else
1708     if nextIsMoveTo then
1709     begin
1710       startPoint := APoints[i];
1711       moveTo(startPoint);
1712       nextIsMoveTo:= false;
1713     end
1714     else
1715     begin
1716       with APoints[i] do
1717         if (x = startPoint.x) and (y = startPoint.y) then
1718           closePath
1719         else
1720           lineTo(APoints[i]);
1721     end;
1722   end;
1723 end;
1724 
1725 procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel;
1726   AWidth: single; AAcceptedDeviation: single);
1727 begin
1728   stroke(ABitmap,AffineMatrixIdentity,AColor,AWidth,AAcceptedDeviation);
1729 end;
1730 
1731 procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner;
1732   AWidth: single; AAcceptedDeviation: single);
1733 begin
1734   stroke(ABitmap,AffineMatrixIdentity,ATexture,AWidth,AAcceptedDeviation);
1735 end;
1736 
1737 procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; x, y: single;
1738   AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single);
1739 begin
1740   stroke(ABitmap,AffineMatrixTranslation(x,y),AColor,AWidth,AAcceptedDeviation);
1741 end;
1742 
1743 procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; x, y: single;
1744   ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single);
1745 begin
1746   stroke(ABitmap,AffineMatrixTranslation(x,y),ATexture,AWidth,AAcceptedDeviation);
1747 end;
1748 
1749 procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix;
1750   AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single);
1751 var data: TStrokeData;
1752 begin
1753   data.Bitmap := ABitmap;
1754   data.Texture := nil;
1755   data.Color := AColor;
1756   data.Width := AWidth;
1757   InternalDraw(@BitmapDrawSubPathProc, AMatrix, AAcceptedDeviation, @data);
1758 end;
1759 
1760 procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix;
1761   ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single);
1762 var data: TStrokeData;
1763 begin
1764   data.Bitmap := ABitmap;
1765   data.Texture := ATexture;
1766   data.Color := BGRAPixelTransparent;
1767   data.Width := AWidth;
1768   InternalDraw(@BitmapDrawSubPathProc, AMatrix, AAcceptedDeviation, @data);
1769 end;
1770 
1771 procedure TBGRAPath.stroke(ADrawProc: TBGRAPathDrawProc; AData: pointer);
1772 begin
1773   stroke(ADrawProc, AffineMatrixIdentity, DefaultDeviation, AData);
1774 end;
1775 
1776 procedure TBGRAPath.stroke(ADrawProc: TBGRAPathDrawProc;
1777   const AMatrix: TAffineMatrix; AData: pointer);
1778 begin
1779   stroke(ADrawProc, AMatrix, DefaultDeviation, AData);
1780 end;
1781 
1782 procedure TBGRAPath.stroke(ADrawProc: TBGRAPathDrawProc;
1783   const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer);
1784 begin
1785   InternalDraw(ADrawProc,AMatrix,AAcceptedDeviation,AData);
1786 end;
1787 
1788 procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel;
1789   AAcceptedDeviation: single);
1790 begin
1791   fill(ABitmap,AffineMatrixIdentity,AColor,AAcceptedDeviation);
1792 end;
1793 
1794 procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner;
1795   AAcceptedDeviation: single);
1796 begin
1797   fill(ABitmap,AffineMatrixIdentity,ATexture,AAcceptedDeviation);
1798 end;
1799 
1800 procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; x, y: single;
1801   AColor: TBGRAPixel; AAcceptedDeviation: single);
1802 begin
1803   fill(ABitmap,AffineMatrixTranslation(x,y),AColor,AAcceptedDeviation);
1804 end;
1805 
1806 procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; x, y: single;
1807   ATexture: IBGRAScanner; AAcceptedDeviation: single);
1808 begin
1809   fill(ABitmap,AffineMatrixTranslation(x,y),ATexture,AAcceptedDeviation);
1810 end;
1811 
1812 procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix;
1813   AColor: TBGRAPixel; AAcceptedDeviation: single);
1814 begin
1815   ABitmap.FillPolyAntialias(ToPoints(AMatrix,AAcceptedDeviation), AColor);
1816 end;
1817 
1818 procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix;
1819   ATexture: IBGRAScanner; AAcceptedDeviation: single);
1820 begin
1821   ABitmap.FillPolyAntialias(ToPoints(AMatrix,AAcceptedDeviation), ATexture);
1822 end;
1823 
1824 procedure TBGRAPath.fill(AFillProc: TBGRAPathFillProc; AData: pointer);
1825 begin
1826   fill(AFillProc, AffineMatrixIdentity, DefaultDeviation, AData);
1827 end;
1828 
1829 procedure TBGRAPath.fill(AFillProc: TBGRAPathFillProc;
1830   const AMatrix: TAffineMatrix; AData: pointer);
1831 begin
1832   fill(AFillProc, AMatrix, DefaultDeviation, AData);
1833 end;
1834 
1835 procedure TBGRAPath.fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix;
1836   AAcceptedDeviation: single; AData: pointer);
1837 begin
1838   AFillProc(ToPoints(AMatrix,AAcceptedDeviation), AData);
1839 end;
1840 
TBGRAPath.CreateCursornull1841 function TBGRAPath.CreateCursor(AAcceptedDeviation: single): TBGRAPathCursor;
1842 begin
1843   result := TBGRAPathCursor.Create(self, AAcceptedDeviation);
1844 end;
1845 
1846 procedure TBGRAPath.Fit(ARect: TRectF; AAcceptedDeviation: single);
1847 var
1848   temp: TBGRAPath;
1849 begin
1850   temp := TBGRAPath.Create;
1851   copyTo(temp);
1852   temp.FitInto(self, ARect, AAcceptedDeviation);
1853   temp.Free;
1854 end;
1855 
1856 procedure TBGRAPath.FitInto(ADest: TBGRAPath; ARect: TRectF;
1857   AAcceptedDeviation: single);
1858 var bounds: TRectF;
1859     zoomX,zoomY: single;
1860 begin
1861   bounds := GetBounds(AAcceptedDeviation);
1862   ADest.beginPath;
1863   ADest.translate((ARect.Left+ARect.Right)*0.5, (ARect.Bottom+ARect.Top)*0.5);
1864   if bounds.Right-bounds.Left <> 0 then
1865   begin
1866     zoomX := (ARect.Right-ARect.Left)/(bounds.Right-bounds.Left);
1867     if bounds.Bottom-bounds.Top > 0 then
1868     begin
1869       zoomY := (ARect.Bottom-ARect.Top)/(bounds.Bottom-bounds.Top);
1870       if zoomY < zoomX then ADest.scale(zoomY) else ADest.scale(zoomX);
1871     end else
1872       ADest.scale(zoomX);
1873   end else
1874   if bounds.Bottom-bounds.Top > 0 then
1875   begin
1876     zoomY := (ARect.Bottom-ARect.Top)/(bounds.Bottom-bounds.Top);
1877     ADest.scale(zoomY);
1878   end;
1879   ADest.translate(-(bounds.Left+bounds.Right)*0.5, -(bounds.Bottom+bounds.Top)*0.5);
1880   copyTo(ADest);
1881   ADest.resetTransform;
1882 end;
1883 
GetSvgStringnull1884 function TBGRAPath.GetSvgString: string;
1885 const RadToDeg = 180/Pi;
1886 var
1887   formats: TFormatSettings;
1888   lastPosF: TPointF;
1889   implicitCommand: char;
1890 
FloatToStringnull1891   function FloatToString(value: single): string;
1892   begin
1893     result := FloatToStrF(value,ffGeneral,7,0,formats)+' ';
1894   end;
1895 
CoordToStringnull1896   function CoordToString(const pt: TPointF): string;
1897   begin
1898     lastPosF := pt;
1899     result := FloatToString(pt.x)+FloatToString(pt.y);
1900   end;
1901 
BoolToStringnull1902   function BoolToString(value: boolean): string;
1903   begin
1904     if value then
1905       result := '1 ' else result := '0 ';
1906   end;
1907 
1908   procedure addCommand(command: char; parameters: string);
1909   begin
1910     if result <> '' then AppendStr(Result, ' '); //optional whitespace
1911     if command <> implicitCommand then AppendStr(Result, command);
1912     AppendStr(Result, trim(parameters));
1913     if command = 'M' then implicitCommand:= 'L'
1914     else if command = 'm' then implicitCommand:= 'l'
1915     else if command in['z','Z'] then implicitCommand:= #0
1916     else implicitCommand := command;
1917   end;
1918 
1919 var elemType: TBGRAPathElementType;
1920     elem: pointer;
1921     a: PArcElement;
1922     Pos: PtrInt;
1923     p1: TPointF;
1924     pts: array of TPointF;
1925     i: integer;
1926 begin
1927   formats := DefaultFormatSettings;
1928   formats.DecimalSeparator := '.';
1929 
1930   result := '';
1931   Pos := 0;
1932   lastPosF := EmptyPointF;
1933   implicitCommand := #0;
1934   repeat
1935     GetElementAt(Pos, elemType, elem);
1936     if elem = nil then break;
1937     case elemType of
1938       peMoveTo: addCommand('M',CoordToString(PPointF(elem)^));
1939       peLineTo: addCommand('L',CoordToString(PPointF(elem)^));
1940       peCloseSubPath: addCommand('z','');
1941       peQuadraticBezierTo:
1942         with PQuadraticBezierToElement(elem)^ do
1943           addCommand('Q',CoordToString(ControlPoint)+CoordToString(Destination));
1944       peCubicBezierTo:
1945         with PCubicBezierToElement(elem)^ do
1946           addCommand('C',CoordToString(ControlPoint1)+
1947                CoordToString(ControlPoint2)+CoordToString(Destination));
1948       peArc:
1949         begin
1950           a := PArcElement(elem);
1951           p1 := ArcStartPoint(a^);
1952           if isEmptyPointF(lastPosF) or (p1 <> lastPosF) then
1953             addCommand('L',CoordToString(p1));
1954           addCommand('A',CoordToString(a^.radius)+
1955              FloatToString(a^.xAngleRadCW*RadToDeg)+
1956              BoolToString(IsLargeArc(a^))+
1957              BoolToString(not a^.anticlockwise)+
1958              CoordToString(ArcEndPoint(a^)));
1959         end;
1960       peOpenedSpline, peClosedSpline:
1961         begin
1962           pts := GetPolygonalApprox(Pos, DefaultDeviation,True);
1963           for i := 0 to high(pts) do
1964           begin
1965             if isEmptyPointF(lastPosF) then
1966               addCommand('M',CoordToString(pts[i]))
1967             else
1968               addCommand('L',CoordToString(pts[i]));
1969           end;
1970         end;
1971     end;
1972   until not GoToNextElement(Pos);
1973 end;
1974 
1975 procedure TBGRAPath.SetSvgString(const AValue: string);
1976 begin
1977   resetTransform;
1978   beginPath;
1979   addPath(AValue);
1980 end;
1981 
1982 procedure TBGRAPath.RegisterCursor(ACursor: TBGRAPathCursor);
1983 begin
1984   setlength(FCursors, length(FCursors)+1);
1985   FCursors[high(FCursors)] := ACursor;
1986 end;
1987 
1988 procedure TBGRAPath.UnregisterCursor(ACursor: TBGRAPathCursor);
1989 var
1990   i,j: Integer;
1991 begin
1992   for i := high(FCursors) downto 0 do
1993     if FCursors[i] = ACursor then
1994     begin
1995       for j := i to high(FCursors)-1 do
1996         FCursors[j] := FCursors[j+1];
1997       setlength(FCursors, length(FCursors)-1);
1998       exit;
1999     end;
2000 end;
2001 
TBGRAPath.SetLastCoordnull2002 function TBGRAPath.SetLastCoord(ACoord: TPointF): TPointF;
2003 begin
2004   FLastCoord := ACoord;
2005   FLastTransformedCoord := FMatrix*ACoord;
2006   result := FLastTransformedCoord;
2007 end;
2008 
2009 procedure TBGRAPath.ClearLastCoord;
2010 begin
2011   FLastCoord := EmptyPointF;
2012   FLastTransformedCoord := EmptyPointF;
2013 end;
2014 
2015 procedure TBGRAPath.BezierCurveFromTransformed(tcp1, cp2, pt: TPointF);
2016 begin
2017   with PCubicBezierToElement(AllocateElement(peCubicBezierTo))^ do
2018   begin
2019     ControlPoint1 := tcp1;
2020     ControlPoint2 := FMatrix*cp2;
2021     Destination := SetLastCoord(pt);
2022     FExpectedTransformedControlPoint := Destination + (Destination-ControlPoint2);
2023   end;
2024 end;
2025 
2026 procedure TBGRAPath.QuadraticCurveFromTransformed(tcp, pt: TPointF);
2027 begin
2028   with PQuadraticBezierToElement(AllocateElement(peQuadraticBezierTo))^ do
2029   begin
2030     ControlPoint := tcp;
2031     Destination := SetLastCoord(pt);
2032     FExpectedTransformedControlPoint := Destination+(Destination-ControlPoint);
2033   end;
2034 end;
2035 
LastCoordDefinednull2036 function TBGRAPath.LastCoordDefined: boolean;
2037 begin
2038   result := not isEmptyPointF(FLastTransformedCoord);
2039 end;
2040 
GetPolygonalApproxnull2041 function TBGRAPath.GetPolygonalApprox(APos: IntPtr; AAcceptedDeviation: single; AIncludeFirstPoint: boolean): ArrayOfTPointF;
2042 var pts: ArrayOfTPointF;
2043   elemType: TBGRAPathElementType;
2044   elem: pointer;
2045   pt : TPointF;
2046   i: Int32or64;
2047 begin
2048   GetElementAt(APos, elemType, elem);
2049   case elemType of
2050     peQuadraticBezierTo:
2051       with PQuadraticBezierToElement(elem)^ do
2052         result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint,Destination).ToPoints(AAcceptedDeviation, AIncludeFirstPoint);
2053     peCubicBezierTo:
2054       with PCubicBezierToElement(elem)^ do
2055         result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint1,ControlPoint2,Destination).ToPoints(AAcceptedDeviation, AIncludeFirstPoint);
2056     peArc:
2057       begin
2058         result := ComputeArc(PArcElement(elem)^, DefaultDeviation/AAcceptedDeviation);
2059         pt := GetElementStartCoord(APos);
2060         if pt <> result[0] then
2061         begin
2062           setlength(result, length(result)+1);
2063           for i := high(result) downto 1 do
2064             result[i] := result[i-1];
2065           result[0] := pt;
2066         end;
2067       end;
2068     peOpenedSpline, peClosedSpline:
2069       with PSplineElement(elem)^ do
2070       begin
2071         setlength(pts, NbControlPoints);
2072         move(Pointer(PSplineElement(elem)+1)^, pts[0], NbControlPoints*sizeof(TPointF));
2073         if elemType = peOpenedSpline then
2074           result := ComputeOpenedSpline(pts, SplineStyle, 0.25, AAcceptedDeviation)
2075         else
2076           result := ComputeClosedSpline(pts, SplineStyle, AAcceptedDeviation);
2077       end;
2078   end;
2079 end;
2080 
TBGRAPath.getPointsnull2081 function TBGRAPath.getPoints: ArrayOfTPointF;
2082 begin
2083   result := ToPoints;
2084 end;
2085 
TBGRAPath.getPointsnull2086 function TBGRAPath.getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF;
2087 begin
2088   result := ToPoints(AMatrix);
2089 end;
2090 
TBGRAPath.getLengthnull2091 function TBGRAPath.getLength: single;
2092 begin
2093   result := ComputeLength;
2094 end;
2095 
TBGRAPath.getCursornull2096 function TBGRAPath.getCursor: TBGRACustomPathCursor;
2097 begin
2098   result := CreateCursor;
2099 end;
2100 
2101 procedure TBGRAPath.InternalDraw(ADrawProc: TBGRAPathDrawProc;
2102   const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer);
2103 var
2104   nbSub: Int32or64;
2105 
2106   procedure OutputSub(subPathStartPos, subPathEndPos: IntPtr);
2107   var
2108     sub: array of ArrayOfTPointF;
2109     temp: ArrayOfTPointF;
2110     startPos,pos,nbPts,curPt,curSub: Int32or64;
2111     elemType: TBGRAPathElementType;
2112     elem: pointer;
2113   begin
2114     pos := subPathStartPos;
2115     setlength(sub, nbSub);
2116     curSub := 0;
2117     while (pos <= subPathEndPos) and (curSub < nbSub) do
2118     begin
2119       GetElementAt(pos, elemType, elem);
2120       if elem = nil then break;
2121       case elemType of
2122         peMoveTo,peLineTo,peCloseSubPath: begin
2123             startPos := pos;
2124             if (elemType = peMoveTo) and (curSub > 0) then
2125               nbPts := 2
2126             else
2127               nbPts := 1;
2128             while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
2129             begin
2130               GoToNextElement(pos);
2131               inc(nbPts);
2132             end;
2133             setlength(temp, nbPts);
2134             pos := startPos;
2135             if (elemType = peMoveTo) and (curSub > 0) then
2136             begin
2137               temp[0] := EmptyPointF;
2138               temp[1] := PPointF(elem)^;
2139               curPt := 2;
2140             end else
2141             begin
2142               temp[0] := PPointF(elem)^;
2143               curPt := 1;
2144             end;
2145             while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
2146             begin
2147               GoToNextElement(pos);
2148               GetElementAt(pos, elemType, elem);
2149               temp[curPt] := PPointF(elem)^;
2150               inc(curPt);
2151             end;
2152             sub[curSub] := temp;
2153             inc(curSub);
2154             temp := nil;
2155           end;
2156         peQuadraticBezierTo,peCubicBezierTo,peArc,
2157         peOpenedSpline, peClosedSpline:
2158           begin
2159             sub[curSub] := GetPolygonalApprox(pos, AAcceptedDeviation, False);
2160             inc(curSub);
2161           end;
2162       end;
2163       GoToNextElement(pos);
2164     end;
2165     temp := ConcatPointsF(sub);
2166     if not IsAffineMatrixIdentity(AMatrix) then
2167       temp := AMatrix*temp;
2168     if (elemType = peCloseSubPath) or ((curSub = 2) and (elemType = peClosedSpline)) then
2169       ADrawProc(temp, True, AData)
2170     else
2171       ADrawProc(temp, False, AData);
2172   end;
2173 
2174 var
2175   subPathStartPos: IntPtr;
2176   prevPos,pos: PtrInt;
2177   elemType: TBGRAPathElementType;
2178   elem: pointer;
2179 begin
2180   AAcceptedDeviation := CorrectAcceptedDeviation(AAcceptedDeviation, AMatrix);
2181   pos := 0;
2182   nbSub := 0;
2183   subPathStartPos := pos;
2184   repeat
2185     prevPos := pos;
2186     GetElementAt(pos, elemType, elem);
2187     if elem = nil then
2188     begin
2189       pos := prevPos;
2190       break;
2191     end;
2192     if (elemType = peMoveTo) and (nbSub > 0) then
2193     begin
2194       OutputSub(subPathStartPos,prevPos);
2195       nbSub := 0;
2196       subPathStartPos := pos;
2197     end;
2198     case elemType of
2199       peMoveTo,peLineTo,peCloseSubPath: begin
2200           inc(nbSub);
2201           while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
2202             GoToNextElement(pos);
2203         end;
2204       peQuadraticBezierTo, peCubicBezierTo, peArc, peOpenedSpline, peClosedSpline: inc(nbSub);
2205     end;
2206   until not GoToNextElement(pos);
2207   if nbSub > 0 then OutputSub(subPathStartPos,pos);
2208 end;
2209 
2210 procedure TBGRAPath.addPath(const AValue: string);
2211 var p: integer;
2212     numberError: boolean;
2213     startCoord,lastCoord: TPointF;
2214 
parseFloatnull2215   function parseFloat: single;
2216   var numberStart: integer;
2217       errPos: integer;
2218       decimalFind: boolean;
2219 
2220     procedure parseFloatInternal;
2221     begin
2222       if (p <= length(AValue)) and (AValue[p] in['+','-']) then inc(p);
2223       decimalFind:= false;
2224       while (p <= length(AValue)) and (AValue[p] in['0'..'9','.']) do
2225       begin
2226         if AValue[p] = '.' then
2227           if decimalFind then
2228             Break
2229           else
2230             decimalFind:= true;
2231         inc(p);
2232       end;
2233     end;
2234 
2235   begin
2236     while (p <= length(AValue)) and (AValue[p] in[#0..#32,',']) do inc(p);
2237     numberStart:= p;
2238     parseFloatInternal;
2239     if (p <= length(AValue)) and (AValue[p] in['e','E']) then
2240     begin
2241       inc(p);
2242       parseFloatInternal;
2243     end;
2244     val(copy(AValue,numberStart,p-numberStart),result,errPos);
2245     if errPos <> 0 then numberError := true;
2246   end;
2247 
parseCoordnull2248   function parseCoord(relative: boolean): TPointF;
2249   begin
2250     result.x := parseFloat;
2251     result.y := parseFloat;
2252     if relative and not isEmptyPointF(lastCoord) then result.Offset(lastCoord);
2253     if isEmptyPointF(lastCoord) then startCoord := result;
2254   end;
2255 
2256 var
2257   command,implicitCommand: char;
2258   relative: boolean;
2259   c1,c2,p1: TPointF;
2260   a: TArcDef;
2261   largeArc: boolean;
2262 begin
2263   BeginSubPath;
2264   lastCoord := EmptyPointF;
2265   startCoord := EmptyPointF;
2266   p := 1;
2267   implicitCommand:= #0;
2268   while p <= length(AValue) do
2269   begin
2270     command := AValue[p];
2271     if (command in['0'..'9','.','+','-']) and (implicitCommand <> #0) then
2272       command := implicitCommand
2273     else
2274     begin
2275       inc(p);
2276     end;
2277     relative := (command = lowerCase(command));
2278     numberError := false;
2279     if upcase(command) in ['L','H','V','C','S','Q','T','A'] then
2280       implicitCommand:= command; //by default the command repeats
2281     case upcase(command) of
2282     'Z': begin
2283            closePath;
2284            implicitCommand:= #0;
2285            lastCoord := startCoord;
2286          end;
2287     'M': begin
2288            p1 := parseCoord(relative);
2289            if not numberError then
2290            begin
2291              moveTo(p1);
2292              lastCoord := p1;
2293              startCoord := p1;
2294            end;
2295            if relative then implicitCommand:= 'l' else
2296              implicitCommand:= 'L';
2297       end;
2298     'L': begin
2299            p1 := parseCoord(relative);
2300            if not numberError then
2301            begin
2302              lineTo(p1);
2303              lastCoord := p1;
2304            end;
2305       end;
2306     'H': begin
2307         if not isEmptyPointF(lastCoord) then
2308         begin
2309           p1 := lastCoord;
2310           if relative then IncF(p1.x, parseFloat)
2311           else p1.x := parseFloat;
2312         end else
2313         begin
2314           p1 := PointF(parseFloat,0);
2315           lastCoord := p1;
2316           startCoord := p1;
2317         end;
2318         if not numberError then
2319         begin
2320           lineTo(p1);
2321           lastCoord := p1;
2322         end;
2323       end;
2324     'V': begin
2325         if not isEmptyPointF(lastCoord) then
2326         begin
2327           p1 := lastCoord;
2328           if relative then IncF(p1.y, parseFloat)
2329           else p1.y := parseFloat;
2330         end else
2331         begin
2332           p1 := PointF(0,parseFloat);
2333           lastCoord := p1;
2334           startCoord := p1;
2335         end;
2336         if not numberError then
2337         begin
2338           lineTo(p1);
2339           lastCoord := p1;
2340         end;
2341       end;
2342     'C': begin
2343         c1 := parseCoord(relative);
2344         c2 := parseCoord(relative);
2345         p1 := parseCoord(relative);
2346         if not numberError then
2347         begin
2348           bezierCurveTo(c1,c2,p1);
2349           lastCoord := p1;
2350         end;
2351       end;
2352     'S': begin
2353         c2 := parseCoord(relative);
2354         p1 := parseCoord(relative);
2355         if not numberError then
2356         begin
2357           smoothBezierCurveTo(c2,p1);
2358           lastCoord := p1;
2359         end;
2360       end;
2361     'Q': begin
2362         c1 := parseCoord(relative);
2363         p1 := parseCoord(relative);
2364         if not numberError then
2365         begin
2366           quadraticCurveTo(c1,p1);
2367           lastCoord := p1;
2368         end;
2369       end;
2370     'T': begin
2371         p1 := parseCoord(relative);
2372         if not numberError then
2373         begin
2374           smoothQuadraticCurveTo(p1);
2375           lastCoord := p1;
2376         end;
2377     end;
2378     'A':
2379       begin
2380         a.radius.x := parseFloat;
2381         a.radius.y := parseFloat;
2382         a.xAngleRadCW := parseFloat*Pi/180;
2383         largeArc := parseFloat<>0;
2384         a.anticlockwise:= parseFloat=0;
2385         p1 := parseCoord(relative);
2386         if not numberError then
2387         begin
2388           arcTo(a.radius.x,a.radius.y,a.xAngleRadCW,largeArc,a.anticlockwise,p1.x,p1.y);
2389           lastCoord := p1;
2390         end;
2391       end;
2392     end;
2393   end;
2394 end;
2395 
2396 procedure TBGRAPath.addPath(source: IBGRAPath);
2397 begin
2398   source.copyTo(self);
2399 end;
2400 
2401 procedure TBGRAPath.openedSpline(const pts: array of TPointF;
2402   style: TSplineStyle);
2403 var elem: PSplineElement;
2404   i: Int32or64;
2405   p: PPointF;
2406 begin
2407   if length(pts) = 0 then exit;
2408   for i := 0 to high(pts) do
2409     if isEmptyPointF(pts[i]) then
2410       raise exception.Create('Unexpected empty point');
2411   if length(pts) <= 2 then
2412   begin
2413     polyline(pts);
2414     exit;
2415   end;
2416   if not LastCoordDefined then moveTo(pts[0]);
2417   elem := AllocateElement(peOpenedSpline, length(pts)*sizeof(TPointF));
2418   elem^.NbControlPoints := length(pts);
2419   elem^.SplineStyle := style;
2420   p := PPointF(elem+1);
2421   for i := 0 to high(pts)-1 do
2422   begin
2423     p^ := FMatrix*pts[i];
2424     inc(p);
2425   end;
2426   p^ := SetLastCoord(pts[high(pts)]);
2427   inc(p);
2428   PInteger(p)^ := length(pts);
2429 end;
2430 
2431 procedure TBGRAPath.closedSpline(const pts: array of TPointF;
2432   style: TSplineStyle);
2433 var elem: PSplineElement;
2434   i: Int32or64;
2435   p: PPointF;
2436 begin
2437   if length(pts) = 0 then exit;
2438   for i := 0 to high(pts) do
2439     if isEmptyPointF(pts[i]) then
2440       raise exception.Create('Unexpected empty point');
2441   if not LastCoordDefined then moveTo(ClosedSplineStartPoint(pts, style));
2442   if length(pts) <= 2 then exit;
2443   elem := AllocateElement(peClosedSpline, length(pts)*sizeof(TPointF));
2444   elem^.NbControlPoints := length(pts);
2445   elem^.SplineStyle := style;
2446   p := PPointF(elem+1);
2447   for i := 0 to high(pts) do
2448   begin
2449     p^ := FMatrix*pts[i];
2450     inc(p);
2451   end;
2452   PInteger(p)^ := length(pts);
2453 end;
2454 
2455 procedure TBGRAPath.BitmapDrawSubPathProc(const APoints: array of TPointF;
2456   AClosed: boolean; AData: pointer);
2457 begin
2458   with TStrokeData(AData^) do
2459   if AClosed then
2460   begin
2461     if Texture <> nil then
2462       Bitmap.DrawPolygonAntialias(APoints, Texture, Width)
2463     else
2464       Bitmap.DrawPolygonAntialias(APoints, Color, Width);
2465   end else
2466   begin
2467     if Texture <> nil then
2468       Bitmap.DrawPolyLineAntialiasAutocycle(APoints, Texture, Width)
2469     else
2470       Bitmap.DrawPolyLineAntialiasAutocycle(APoints, Color, Width);
2471   end;
2472 end;
2473 
CorrectAcceptedDeviationnull2474 function TBGRAPath.CorrectAcceptedDeviation(AAcceptedDeviation: single;
2475   const AMatrix: TAffineMatrix): single;
2476 var maxZoom: single;
2477 begin
2478   //determine the zoom of the matrix
2479   maxZoom := Max(VectLen(PointF(AMatrix[1,1],AMatrix[2,1])),
2480      VectLen(PointF(AMatrix[1,2],AMatrix[2,2])));
2481   //make the accepted deviation smaller if the matrix zooms to avoid that
2482   // curves would look angular
2483   if maxZoom = 0 then
2484     result:= 1e10
2485   else
2486     result := AAcceptedDeviation / maxZoom;
2487 end;
2488 
2489 procedure TBGRAPath.OnModify;
2490 begin
2491   if length(FCursors)> 0 then
2492       raise Exception.Create('You cannot modify the path when there are cursors');
2493 end;
2494 
2495 procedure TBGRAPath.OnMatrixChange;
2496 begin
2497   //transformed coord are not changed,
2498   //but original coords are lost in the process.
2499   //this has a consequence when using
2500   //arc functions that rely on the previous
2501   //coordinate
2502   FLastCoord := EmptyPointF;
2503   FSubPathStartCoord := EmptyPointF;
2504 end;
2505 
2506 procedure TBGRAPath.NeedSpace(count: integer);
2507 begin
2508   OnModify;
2509   inc(count, 4); //avoid memory error
2510   if FDataPos + count > FDataCapacity then
2511   begin
2512     FDataCapacity := (FDataCapacity shl 1)+8;
2513     if FDataPos + count + 8 > FDataCapacity then
2514       FDataCapacity := FDataPos + count + 8;
2515     ReAllocMem(FData, FDataCapacity);
2516   end;
2517 end;
2518 
AllocateElementnull2519 function TBGRAPath.AllocateElement(AElementType: TBGRAPathElementType;
2520   AExtraBytes: PtrInt): Pointer;
2521 var t: PtrInt;
2522 begin
2523   if not (AElementType in [succ(peNone)..high(TBGRAPathElementType)]) then
2524     raise exception.Create('Invalid element type');
2525   OnModify;
2526   t := PathElementSize[AElementType]+AExtraBytes;
2527   NeedSpace(SizeOf(TPathElementHeader)+t);
2528   with PPathElementHeader(FData+FDataPos)^ do
2529   begin
2530     ElementType:= AElementType;
2531     PreviousElementType := FLastStoredElementType;
2532   end;
2533   result := FData+(FDataPos+SizeOf(TPathElementHeader));
2534   FLastSubPathElementType:= AElementType;
2535   FLastStoredElementType:= AElementType;
2536   Inc(FDataPos, sizeof(TPathElementHeader)+t);
2537 end;
2538 
2539 procedure TBGRAPath.Init;
2540 begin
2541   FData := nil;
2542   FDataCapacity := 0;
2543   FLastMoveToDataPos := -1;
2544   beginPath;
2545   resetTransform;
2546 end;
2547 
TBGRAPath.GoToNextElementnull2548 function TBGRAPath.GoToNextElement(var APos: PtrInt): boolean;
2549 var newPos: PtrInt;
2550   p: PSplineElement;
2551   elemType: TBGRAPathElementType;
2552 begin
2553   if APos >= FDataPos then
2554     result := false
2555   else
2556   begin
2557     elemType := PPathElementHeader(FData+APos)^.ElementType;
2558     newPos := APos + sizeof(TPathElementHeader) + PathElementSize[elemType];
2559     if elemType in[peOpenedSpline,peClosedSpline] then
2560     begin
2561       p := PSplineElement(FData+(APos+sizeof(TPathElementHeader)));
2562       inc(newPos, p^.NbControlPoints * sizeof(TPointF) ); //extra
2563     end;
2564     if newPos < FDataPos then
2565     begin
2566       result := true;
2567       APos := newPos;
2568       if not CheckElementType(PPathElementHeader(FData+APos)^.ElementType) or
2569         not CheckElementType(PPathElementHeader(FData+APos)^.PreviousElementType) then
2570           raise exception.Create('Internal structure error');
2571     end
2572     else
2573       result := false;
2574   end;
2575 end;
2576 
TBGRAPath.GoToPreviousElementnull2577 function TBGRAPath.GoToPreviousElement(var APos: PtrInt): boolean;
2578 var lastElemType: TBGRAPathElementType;
2579 begin
2580   if APos <= 0 then
2581     result := false
2582   else
2583   begin
2584     result := true;
2585     if (APos = FDataPos) then
2586       lastElemType := FLastStoredElementType
2587     else
2588       lastElemType := PPathElementHeader(FData+APos)^.PreviousElementType;
2589 
2590     if lastElemType in [peOpenedSpline,peClosedSpline] then
2591       dec(APos, (PInteger(FData+APos)-1)^ *sizeof(TPointF)); //extra
2592     dec(APos, sizeof(TPathElementHeader) + PathElementSize[lastElemType]);
2593 
2594     if not CheckElementType(PPathElementHeader(FData+APos)^.ElementType) or
2595       not CheckElementType(PPathElementHeader(FData+APos)^.PreviousElementType) then
2596         raise exception.Create('Internal structure error');
2597   end;
2598 end;
2599 
TBGRAPath.PeekNextElementnull2600 function TBGRAPath.PeekNextElement(APos: PtrInt): TBGRAPathElementType;
2601 begin
2602   if not GoToNextElement(APos) then
2603     result := peNone
2604   else
2605     result := PPathElementHeader(FData+APos)^.ElementType;
2606 end;
2607 
TBGRAPath.GetElementStartCoordnull2608 function TBGRAPath.GetElementStartCoord(APos: PtrInt): TPointF;
2609 var
2610   elemType: TBGRAPathElementType;
2611   elem: pointer;
2612 begin
2613   GetElementAt(APos, elemType, elem);
2614   case elemType of
2615   peNone: raise exception.Create('No element');
2616   peMoveTo: result := PPointF(elem)^;
2617   else
2618     begin
2619       if not GoToPreviousElement(APos) then
2620         raise exception.Create('No previous element')
2621       else
2622       begin
2623         result := GetElementEndCoord(APos);
2624       end;
2625     end;
2626   end;
2627 end;
2628 
TBGRAPath.GetElementEndCoordnull2629 function TBGRAPath.GetElementEndCoord(APos: PtrInt): TPointF;
2630 var elemType: TBGRAPathElementType;
2631   elem: pointer;
2632 begin
2633   GetElementAt(APos, elemType, elem);
2634   case elemType of
2635   peMoveTo,peLineTo,peCloseSubPath: result := PPointF(elem)^;
2636   peQuadraticBezierTo: result := PQuadraticBezierToElement(elem)^.Destination;
2637   peCubicBezierTo: result := PCubicBezierToElement(elem)^.Destination;
2638   peArc: result := ArcEndPoint(PArcElement(elem)^);
2639   peClosedSpline: result := PPointF(PSplineElement(elem)+1)^;
2640   peOpenedSpline: result := (PPointF(PSplineElement(elem)+1)+(PSplineElement(elem)^.NbControlPoints-1))^;
2641   else
2642     result := EmptyPointF;
2643   end;
2644 end;
2645 
GetElementLengthnull2646 function TBGRAPath.GetElementLength(APos: PtrInt; AAcceptedDeviation: single): Single;
2647 var elemType: TBGRAPathElementType;
2648   elem: pointer;
2649   pts: array of TPointF;
2650 begin
2651   GetElementAt(APos, elemType, elem);
2652   case elemType of
2653   peMoveTo: result := 0;
2654   peLineTo,peCloseSubPath: result := VectLen(PPointF(elem)^ - GetElementStartCoord(APos))*FScale;
2655   peQuadraticBezierTo: with PQuadraticBezierToElement(elem)^ do
2656       result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint,Destination).ComputeLength;
2657   peCubicBezierTo: with PCubicBezierToElement(elem)^ do
2658       result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint1,ControlPoint2,Destination).ComputeLength(AAcceptedDeviation);
2659   peArc: begin
2660       result := VectLen(ArcStartPoint(PArcElement(elem)^) - GetElementStartCoord(APos));
2661       IncF(result, PolylineLen(ComputeArc(PArcElement(elem)^, DefaultDeviation/AAcceptedDeviation)));
2662     end;
2663   peClosedSpline,peOpenedSpline:
2664     begin
2665       pts := GetPolygonalApprox(APos, AAcceptedDeviation, true);
2666       result := PolylineLen(pts) + VectLen(pts[0]-GetElementStartCoord(APos));
2667     end
2668   else
2669     result := 0;
2670   end;
2671 end;
2672 
2673 procedure TBGRAPath.GetElementAt(APos: PtrInt; out
2674   AElementType: TBGRAPathElementType; out AElement: pointer);
2675 begin
2676   if APos >= FDataPos then
2677   begin
2678     AElementType := peNone;
2679     AElement := nil;
2680   end else
2681   begin
2682     AElementType:= PPathElementHeader(FData+APos)^.ElementType;
2683     AElement := FData+(APos+sizeof(TPathElementHeader));
2684   end;
2685 end;
2686 
2687 constructor TBGRAPath.Create;
2688 begin
2689   Init;
2690 end;
2691 
2692 constructor TBGRAPath.Create(ASvgString: string);
2693 begin
2694   Init;
2695   SvgString:= ASvgString;
2696 end;
2697 
2698 constructor TBGRAPath.Create(const APoints: ArrayOfTPointF);
2699 begin
2700   Init;
2701   SetPoints(APoints);
2702 end;
2703 
2704 constructor TBGRAPath.Create(APath: IBGRAPath);
2705 begin
2706   Init;
2707   APath.copyTo(self);
2708 end;
2709 
2710 destructor TBGRAPath.Destroy;
2711 var i: integer;
2712 begin
2713   for I := 0 to high(FCursors) do
2714     FCursors[i].OnPathFree;
2715   if Assigned(FData) then
2716   begin
2717     FreeMem(FData);
2718     FData := nil;
2719   end;
2720   inherited Destroy;
2721 end;
2722 
2723 procedure TBGRAPath.beginPath;
2724 begin
2725   DoClear;
2726 end;
2727 
2728 procedure TBGRAPath.beginSubPath;
2729 begin
2730   OnModify;
2731   FLastSubPathElementType := peNone;
2732   ClearLastCoord;
2733   FSubPathStartCoord := EmptyPointF;
2734   FExpectedTransformedControlPoint := EmptyPointF;
2735 end;
2736 
2737 procedure TBGRAPath.DoClear;
2738 begin
2739   OnModify;
2740   FDataPos := 0;
2741   BeginSubPath;
2742 end;
2743 
TBGRAPath.CheckElementTypenull2744 function TBGRAPath.CheckElementType(AElementType: TBGRAPathElementType): boolean;
2745 begin
2746   result := AElementType <= high(TBGRAPathElementType);
2747 end;
2748 
2749 procedure TBGRAPath.closePath;
2750 var
2751   moveToType: TBGRAPathElementType;
2752   moveToElem: pointer;
2753 begin
2754   if (FLastSubPathElementType <> peNone) and (FLastSubPathElementType <> peCloseSubPath) then
2755   begin
2756     with PClosePathElement(AllocateElement(peCloseSubPath))^ do
2757     begin
2758       StartCoordinate := FSubPathTransformedStartCoord;
2759       LoopDataPos := FLastMoveToDataPos;
2760     end;
2761     if FLastMoveToDataPos <> -1 then
2762     begin
2763       GetElementAt(FLastMoveToDataPos,moveToType,moveToElem);
2764       PMoveToElement(moveToElem)^.LoopDataPos := FDataPos;
2765       FLastMoveToDataPos:= -1;
2766     end;
2767     FLastCoord := FSubPathStartCoord;
2768     FLastTransformedCoord := FSubPathTransformedStartCoord;
2769   end;
2770 end;
2771 
2772 procedure TBGRAPath.translate(x, y: single);
2773 begin
2774   OnMatrixChange;
2775   FMatrix := FMatrix * AffineMatrixTranslation(x,y);
2776 end;
2777 
2778 procedure TBGRAPath.resetTransform;
2779 begin
2780   OnMatrixChange;
2781   FMatrix := AffineMatrixIdentity;
2782   FAngleRadCW := 0;
2783   FScale:= 1;
2784 end;
2785 
2786 procedure TBGRAPath.rotate(angleRadCW: single);
2787 begin
2788   OnMatrixChange;
2789   FMatrix := FMatrix * AffineMatrixRotationRad(-angleRadCW);
2790   IncF(FAngleRadCW, angleRadCW);
2791 end;
2792 
2793 procedure TBGRAPath.rotateDeg(angleDeg: single);
2794 const degToRad = Pi/180;
2795 begin
2796   rotate(angleDeg*degToRad);
2797 end;
2798 
2799 procedure TBGRAPath.rotate(angleRadCW: single; center: TPointF);
2800 begin
2801   translate(center.x,center.y);
2802   rotate(angleRadCW);
2803   translate(-center.x,-center.y);
2804 end;
2805 
2806 procedure TBGRAPath.rotateDeg(angleDeg: single; center: TPointF);
2807 begin
2808   translate(center.x,center.y);
2809   rotateDeg(angleDeg);
2810   translate(-center.x,-center.y);
2811 end;
2812 
2813 procedure TBGRAPath.scale(factor: single);
2814 begin
2815   OnMatrixChange;
2816   FMatrix := FMatrix * AffineMatrixScale(factor,factor);
2817   FScale := FScale * factor;
2818 end;
2819 
2820 procedure TBGRAPath.moveTo(x, y: single);
2821 begin
2822   moveTo(PointF(x,y));
2823 end;
2824 
2825 procedure TBGRAPath.lineTo(x, y: single);
2826 begin
2827   lineTo(PointF(x,y));
2828 end;
2829 
2830 procedure TBGRAPath.moveTo(constref pt: TPointF);
2831 begin
2832   if FLastSubPathElementType <> peMoveTo then
2833   begin
2834     FLastMoveToDataPos:= FDataPos;
2835     with PMoveToElement(AllocateElement(peMoveTo))^ do
2836     begin
2837       StartCoordinate := SetLastCoord(pt);
2838       LoopDataPos := -1;
2839     end
2840   end else
2841     PMoveToElement(FData+(FDataPos-Sizeof(TMoveToElement)))^.StartCoordinate := SetLastCoord(pt);
2842   FSubPathStartCoord := FLastCoord;
2843   FSubPathTransformedStartCoord := FLastTransformedCoord;
2844 end;
2845 
2846 procedure TBGRAPath.lineTo(constref pt: TPointF);
2847 var lastTransfCoord, newTransfCoord: TPointF;
2848 begin
2849   if LastCoordDefined then
2850   begin
2851     lastTransfCoord := FLastTransformedCoord;
2852     newTransfCoord := SetLastCoord(pt);
2853     if newTransfCoord <> lastTransfCoord then
2854       PPointF(AllocateElement(peLineTo))^ := newTransfCoord;
2855   end else
2856     moveTo(pt);
2857 end;
2858 
2859 procedure TBGRAPath.polyline(const pts: array of TPointF);
2860 var i: integer;
2861 begin
2862   if length(pts) = 0 then exit;
2863   NeedSpace((sizeof(TPathElementHeader)+sizeof(TPointF))*length(pts));
2864   moveTo(pts[0]);
2865   for i := 1 to high(pts) do lineTo(pts[i]);
2866 end;
2867 
2868 procedure TBGRAPath.polylineTo(const pts: array of TPointF);
2869 var i: integer;
2870 begin
2871   NeedSpace((sizeof(TPathElementHeader)+sizeof(TPointF))*length(pts));
2872   for i := 0 to high(pts) do lineTo(pts[i]);
2873 end;
2874 
2875 procedure TBGRAPath.polygon(const pts: array of TPointF);
2876 var lastPt: integer;
2877 begin
2878   if length(pts) = 0 then exit;
2879   lastPt := high(pts);
2880   while (lastPt > 1) and (pts[lastPt] = pts[0]) do dec(lastPt);
2881   if lastPt <> high(pts) then
2882     polyline(slice(pts,lastPt+1))
2883   else
2884     polyline(pts);
2885   closePath;
2886 end;
2887 
2888 procedure TBGRAPath.quadraticCurveTo(cpx, cpy, x, y: single);
2889 begin
2890   quadraticCurveTo(PointF(cpx,cpy),PointF(x,y));
2891 end;
2892 
2893 procedure TBGRAPath.quadraticCurveTo(constref cp, pt: TPointF);
2894 begin
2895   if LastCoordDefined then
2896     QuadraticCurveFromTransformed(FMatrix*cp, pt) else
2897   begin
2898     lineTo(pt);
2899     FExpectedTransformedControlPoint := FMatrix*(pt+(pt-cp));
2900   end;
2901 end;
2902 
2903 procedure TBGRAPath.bezierCurveTo(cp1x, cp1y, cp2x, cp2y, x, y: single);
2904 begin
2905   bezierCurveTo(PointF(cp1x,cp1y),PointF(cp2x,cp2y),PointF(x,y));
2906 end;
2907 
2908 procedure TBGRAPath.bezierCurveTo(constref cp1, cp2, pt: TPointF);
2909 begin
2910   if not LastCoordDefined then moveTo(cp1);
2911   BezierCurveFromTransformed(FMatrix*cp1, cp2, pt);
2912 end;
2913 
2914 procedure TBGRAPath.bezierCurve(const curve: TCubicBezierCurve);
2915 begin
2916   moveTo(curve.p1);
2917   bezierCurveTo(curve.c1,curve.c2,curve.p2);
2918 end;
2919 
2920 procedure TBGRAPath.bezierCurve(p1, cp1, cp2, p2: TPointF);
2921 begin
2922   moveTo(p1);
2923   bezierCurveTo(cp1,cp2,p2);
2924 end;
2925 
2926 procedure TBGRAPath.smoothBezierCurveTo(cp2x, cp2y, x, y: single);
2927 begin
2928   smoothBezierCurveTo(PointF(cp2x,cp2y),PointF(x,y));
2929 end;
2930 
2931 procedure TBGRAPath.smoothBezierCurveTo(const cp2, pt: TPointF);
2932 begin
2933   if (FLastSubPathElementType = peCubicBezierTo) and not isEmptyPointF(FExpectedTransformedControlPoint) then
2934     BezierCurveFromTransformed(FExpectedTransformedControlPoint,cp2,pt)
2935   else if LastCoordDefined then
2936     BezierCurveFromTransformed(FLastTransformedCoord,cp2,pt)
2937   else
2938     bezierCurveTo(cp2,cp2,pt);
2939 end;
2940 
2941 procedure TBGRAPath.quadraticCurve(const curve: TQuadraticBezierCurve);
2942 begin
2943   moveTo(curve.p1);
2944   quadraticCurveTo(curve.c,curve.p2);
2945 end;
2946 
2947 procedure TBGRAPath.quadraticCurve(p1, cp, p2: TPointF);
2948 begin
2949   moveTo(p1);
2950   quadraticCurveTo(cp,p2);
2951 end;
2952 
2953 procedure TBGRAPath.smoothQuadraticCurveTo(x, y: single);
2954 begin
2955   smoothQuadraticCurveTo(PointF(x,y));
2956 end;
2957 
2958 procedure TBGRAPath.smoothQuadraticCurveTo(const pt: TPointF);
2959 begin
2960   if (FLastSubPathElementType = peQuadraticBezierTo) and not isEmptyPointF(FExpectedTransformedControlPoint) then
2961     QuadraticCurveFromTransformed(FExpectedTransformedControlPoint,pt)
2962   else if LastCoordDefined then
2963     QuadraticCurveFromTransformed(FLastTransformedCoord,pt)
2964   else
2965     quadraticCurveTo(pt,pt);
2966 end;
2967 
2968 procedure TBGRAPath.rect(x, y, w, h: single);
2969 begin
2970   moveTo(x,y);
2971   lineTo(x+w,y);
2972   lineTo(x+w,y+h);
2973   lineTo(x,y+h);
2974   closePath;
2975 end;
2976 
2977 procedure TBGRAPath.roundRect(x, y, w, h, radius: single);
2978 begin
2979   if radius <= 0 then
2980   begin
2981     rect(x,y,w,h);
2982     exit;
2983   end;
2984   if (w <= 0) or (h <= 0) then exit;
2985   if radius*2 > w then radius := w/2;
2986   if radius*2 > h then radius := h/2;
2987   moveTo(x+radius,y);
2988   arcTo(PointF(x+w,y),PointF(x+w,y+h), radius);
2989   arcTo(PointF(x+w,y+h),PointF(x,y+h), radius);
2990   arcTo(PointF(x,y+h),PointF(x,y), radius);
2991   arcTo(PointF(x,y),PointF(x+w,y), radius);
2992   closePath;
2993 end;
2994 
2995 procedure TBGRAPath.arc(cx, cy, radius, startAngleRadCW, endAngleRadCW: single;
2996   anticlockwise: boolean);
2997 begin
2998   arc(cx,cy,radius,radius,0,startAngleRadCW,endAngleRadCW,anticlockwise);
2999 end;
3000 
3001 procedure TBGRAPath.arc(cx, cy, radius, startAngleRadCW, endAngleRadCW: single);
3002 begin
3003   arc(cx,cy,radius,startAngleRadCW,endAngleRadCW,false);
3004 end;
3005 
3006 procedure TBGRAPath.arcDeg(cx, cy, radius, startAngleDeg, endAngleDeg: single;
3007   anticlockwise: boolean);
3008 const degToRad = Pi/180;
3009 begin
3010   arc(cx,cy,radius,(startAngleDeg-90)*degToRad,(endAngleDeg-90)*degToRad,anticlockwise);
3011 end;
3012 
3013 procedure TBGRAPath.arcDeg(cx, cy, radius, startAngleDeg, endAngleDeg: single);
3014 const degToRad = Pi/180;
3015 begin
3016   arc(cx,cy,radius,(startAngleDeg-90)*degToRad,(endAngleDeg-90)*degToRad);
3017 end;
3018 
3019 procedure TBGRAPath.arcTo(x1, y1, x2, y2, radius: single);
3020 begin
3021   arcTo(PointF(x1,y1), PointF(x2,y2), radius);
3022 end;
3023 
3024 procedure TBGRAPath.arcTo(const p1, p2: TPointF; radius: single);
3025 var p0 : TPointF;
3026 begin
3027   if IsEmptyPointF(FLastCoord) then
3028     p0 := p1 else p0 := FLastCoord;
3029   arc(Html5ArcTo(p0,p1,p2,radius));
3030 end;
3031 
3032 procedure TBGRAPath.arc(constref arcDef: TArcDef);
3033 var transformedArc: TArcElement;
3034 begin
3035   if (arcDef.radius.x = 0) and (arcDef.radius.y = 0) then
3036     lineTo(arcDef.center)
3037   else
3038   begin
3039     if not LastCoordDefined then
3040       moveTo(ArcStartPoint(arcDef));
3041     transformedArc.anticlockwise := arcDef.anticlockwise;
3042     transformedArc.startAngleRadCW := arcDef.startAngleRadCW;
3043     transformedArc.endAngleRadCW := arcDef.endAngleRadCW;
3044     transformedArc.center := FMatrix*arcDef.center;
3045     transformedArc.radius := arcDef.radius*FScale;
3046     transformedArc.xAngleRadCW := arcDef.xAngleRadCW+FAngleRadCW;
3047     PArcElement(AllocateElement(peArc))^ := transformedArc;
3048 	{$PUSH}{$OPTIMIZATION OFF}
3049     SetLastCoord(ArcEndPoint(arcDef));
3050 	{$POP}
3051   end;
3052 end;
3053 
3054 procedure TBGRAPath.arc(cx, cy, rx, ry: single; xAngleRadCW, startAngleRadCW,
3055   endAngleRadCW: single);
3056 begin
3057   arc(ArcDef(cx,cy,rx,ry,xAngleRadCW,startAngleRadCW,endAngleRadCW,false));
3058 end;
3059 
3060 procedure TBGRAPath.arc(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single;
3061   anticlockwise: boolean);
3062 begin
3063   arc(ArcDef(cx,cy,rx,ry,xAngleRadCW,startAngleRadCW,endAngleRadCW,anticlockwise));
3064 end;
3065 
3066 procedure TBGRAPath.arcTo(rx, ry, xAngleRadCW: single; largeArc,
3067   anticlockwise: boolean; x, y: single);
3068 begin
3069   if IsEmptyPointF(FLastCoord) then
3070     moveTo(x,y)
3071   else
3072     arc(SvgArcTo(FLastCoord, rx,ry, xAngleRadCW, largeArc, anticlockwise, PointF(x,y)));
3073 end;
3074 
3075 procedure TBGRAPath.copyTo(dest: IBGRAPath);
3076 var pos: IntPtr;
3077     elemType: TBGRAPathElementType;
3078     elem: Pointer;
3079     pts: array of TPointF;
3080 begin
3081   pos := 0;
3082   repeat
3083     GetElementAt(pos, elemType, elem);
3084     if elem = nil then break;
3085     case elemType of
3086       peMoveTo: dest.moveTo(PPointF(elem)^);
3087       peLineTo: dest.lineTo(PPointF(elem)^);
3088       peCloseSubPath: dest.closePath;
3089       peQuadraticBezierTo:
3090         with PQuadraticBezierToElement(elem)^ do
3091           dest.quadraticCurveTo(ControlPoint,Destination);
3092       peCubicBezierTo:
3093         with PCubicBezierToElement(elem)^ do
3094           dest.bezierCurveTo(ControlPoint1,ControlPoint2,Destination);
3095       peArc: dest.arc(PArcElement(elem)^);
3096       peOpenedSpline, peClosedSpline:
3097         begin
3098           with PSplineElement(elem)^ do
3099           begin
3100             setlength(pts, NbControlPoints);
3101             move(Pointer(PSplineElement(elem)+1)^, pts[0], NbControlPoints*sizeof(TPointF));
3102             if elemType = peOpenedSpline then
3103               dest.openedSpline(pts, SplineStyle)
3104             else
3105               dest.closedSpline(pts, SplineStyle);
3106             pts := nil;
3107           end;
3108         end;
3109     end;
3110   until not GoToNextElement(pos);
3111 end;
3112 
3113 initialization
3114 
3115   BGRAPathFactory := TBGRAPath;
3116 
3117 end.
3118 
3119