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