Context Navigation

bgrapath.pas

Last change on this file was 2, checked in by chronos, 5 years ago
Source code taken from https://svn.zdechov.net/PascalClassLibrary/GraphicTest/ rev 543.
File size: 89.6 KB

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

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: trunk/Packages/bgrabitmap/bgrapath.pas

Download in other formats: