1{=== Geometry types ===}
2
3{$IFDEF INCLUDE_INTERFACE}
4{$UNDEF INCLUDE_INTERFACE}
5const
6  {* Value indicating that there is nothing in the single-precision floating point value.
7     It is also used as a separator in lists }
8  EmptySingle = single(-3.402823e38);
9
10type
11  TPoint = BGRAClasses.TPoint;
12  TSize = BGRAClasses.TSize;
13
14  {* Pointer to a ''TPointF'' structure }
15  PPointF = ^BGRAClasses.TPointF;
16  {* Contains a point with single-precision floating point coordinates }
17  TPointF = BGRAClasses.TPointF;
18  {* Contains an array of points with single-precision floating point coordinates }
19  ArrayOfTPointF = array of TPointF;
20
21  {* An affine matrix contains three 2D vectors: the image of x, the image of y and the translation }
22  TAffineMatrix = array[1..2,1..3] of single;
23  TRectF = BGRAClasses.TRectF;
24
25{$if FPC_FULLVERSION<030001}
26  {$define BGRA_DEFINE_TRECTHELPER}
27  { TRectHelper }
28
29  TRectHelper = record helper for TRect
30  private
31    function GetHeight: integer;
32    function GetIsEmpty: boolean;
33    function GetWidth: integer;
34    procedure SetHeight(AValue: integer);
35    procedure SetWidth(AValue: integer);
36  public
37    constructor Create(Origin: TPoint; AWidth, AHeight: Longint); overload;
38    constructor Create(ALeft, ATop, ARight, ABottom: Longint); overload;
39    procedure Intersect(R: TRect);
40    class function Intersect(R1: TRect; R2: TRect): TRect; static;
41    function IntersectsWith(R: TRect): Boolean;
42    class function Union(R1, R2: TRect): TRect; static;
43    procedure Union(R: TRect);
44    procedure Offset(DX, DY: Longint);
45    procedure Inflate(DX, DY: Longint);
46    function Contains(const APoint: TPoint): boolean; overload;
47    function Contains(const ARect: TRect): boolean; overload;
48    property Width: integer read GetWidth write SetWidth;
49    property Height: integer read GetHeight write SetHeight;
50    property IsEmpty: boolean read GetIsEmpty;
51  end;
52
53operator=(const ARect1,ARect2: TRect): boolean;
54{$endif}
55
56{$if (FPC_FULLVERSION<030001) or defined(BGRABITMAP_USE_MSEGUI)}
57type
58  {$define BGRA_DEFINE_TSIZEHELPER}
59  { TSizeHelper }
60
61  TSizeHelper = record helper for TSize
62  private
63    function GetHeight: integer;
64    function GetWidth: integer;
65  public
66    property Width: integer read GetWidth;
67    property Height: integer read GetHeight;
68  end;
69{$ENDIF}
70
71const
72  EmptyPoint : TPoint = (X: -2147483648; Y: -2147483648);
73
74function IsEmptyPoint(const APoint: TPoint): boolean;
75
76type
77
78  { TPointFHelper }
79
80  TPointFHelper = record helper for TPointF
81    procedure Offset(const apt : TPointF); overload;
82    procedure Offset(const apt : TPoint); overload;
83    procedure Offset(dx,dy : longint); overload;
84    procedure Offset(dx,dy : single); overload;
85    procedure Scale(AScale: single);
86    procedure Normalize;
87
88    function Ceiling: TPoint;
89    function Truncate: TPoint;
90    function Floor: TPoint;
91    function Round: TPoint;
92    function Length: Single;
93    function IsEmpty: boolean;
94  end;
95
96type
97  PRectF = ^TRectF;
98
99  { TRectFHelper }
100
101  TRectFHelper = record helper for TRectF
102    class function Intersect(const R1: TRectF; const R2: TRectF): TRectF; overload; static;
103    class function Union(const R1: TRectF; const R2: TRectF): TRectF; overload; static;
104    class function Union(const R1: TRectF; const R2: TRectF; ADiscardEmpty: boolean): TRectF; overload; static;
105    function Union(const r: TRectF):TRectF; overload;
106    function Union(const r: TRectF; ADiscardEmpty: boolean):TRectF; overload;
107    procedure Include(const APoint: TPointF);
108    function Contains(const APoint: TPointF; AIncludeBottomRight: boolean = false): boolean;
109    function IntersectsWith(const r: TRectF): boolean;
110    function IsEmpty: boolean;
111  end;
112
113const
114  {* A value for an empty rectangle }
115  EmptyRectF : TRectF = (left:0; top:0; right:0; bottom: 0);
116
117  function RectF(Left, Top, Right, Bottom: Single): TRectF;
118  function RectF(const ATopLeft,ABottomRight: TPointF): TRectF;
119  function RectF(const ARect: TRect): TRectF;
120  function RectWithSizeF(left,top,width,height: Single): TRectF;
121  function IsEmptyRectF(const ARect:TRectF): boolean;
122
123type
124  { TAffineBox }
125
126  TAffineBox = object
127  private
128    function GetAsPolygon: ArrayOfTPointF;
129    function GetBottomRight: TPointF;
130    function GetCenter: TPointF;
131    function GetHeight: single;
132    function GetIsEmpty: boolean;
133    function GetRectBounds: TRect;
134    function GetRectBoundsF: TRectF;
135    function GetSurface: single;
136    function GetWidth: single;
137  public
138    TopLeft, TopRight,
139    BottomLeft: TPointF;
140    class function EmptyBox: TAffineBox; static;
141    class function AffineBox(ATopLeft, ATopRight, ABottomLeft: TPointF): TAffineBox; overload; static;
142    class function AffineBox(ARectF: TRectF): TAffineBox; overload; static;
143    procedure Offset(AOfsX, AOfsY: single); overload;
144    procedure Offset(AOfs: TPointF); overload;
145    procedure Inflate(AHoriz, AVert: single); //inflates along axes
146    function Contains(APoint: TPointF): boolean;
147    property RectBounds: TRect read GetRectBounds;
148    property RectBoundsF: TRectF read GetRectBoundsF;
149    property BottomRight: TPointF read GetBottomRight;
150    property IsEmpty: boolean read GetIsEmpty;
151    property AsPolygon: ArrayOfTPointF read GetAsPolygon;
152    property Width: single read GetWidth;
153    property Height: single read GetHeight;
154    property Surface: single read GetSurface;
155    property Center: TPointF read GetCenter;
156  end;
157
158  const
159    {** Value indicating that there is an empty ''TPointF'' structure.
160        It is also used as a separator in lists of points }
161    EmptyPointF: TPointF = (x: -3.402823e38; y: -3.402823e38);
162
163  {----------------- Operators for TPointF --------------------}
164  {** Creates a new structure with values ''x'' and ''y'' }
165  function PointF(x, y: single): TPointF; overload;
166  function PointF(pt: TPoint): TPointF; overload;
167  {** Checks if the structure is empty (equal to ''EmptyPointF'') }
168  function isEmptyPointF(const pt: TPointF): boolean;
169  {** Checks if both ''x'' and ''y'' are equal }
170  operator = (const pt1, pt2: TPointF): boolean; inline;
171  {** Adds ''x'' and ''y'' components separately. It is like adding vectors }
172  operator + (const pt1, pt2: TPointF): TPointF; inline;
173  {** Subtract ''x'' and ''y'' components separately. It is like subtracting vectors }
174  operator - (const pt1, pt2: TPointF): TPointF; inline;
175  {** Returns a point with opposite values for ''x'' and ''y'' components }
176  operator - (const pt2: TPointF): TPointF; inline;
177  {** Scalar product: multiplies ''x'' and ''y'' components and returns the sum }
178  operator * (const pt1, pt2: TPointF): single; inline;
179  {** Multiplies both ''x'' and ''y'' by ''factor''. It scales the vector represented by (''x'',''y'') }
180  operator * (const pt1: TPointF; factor: single): TPointF; inline;
181  {** Multiplies both ''x'' and ''y'' by ''factor''. It scales the vector represented by (''x'',''y'') }
182  operator * (factor: single; const pt1: TPointF): TPointF; inline;
183  {** Returns the length of the vector (''dx'',''dy'') }
184  function VectLen(dx,dy: single): single; overload;
185  {** Returns the length of the vector represented by (''x'',''y'') }
186  function VectLen(v: TPointF): single; overload;
187  function VectDet(v1,v2: TPointF): double; inline;
188
189type
190  TFaceCulling = (fcNone, fcKeepCW, fcKeepCCW);
191
192  {** Creates an array of ''TPointF'' }
193  function PointsF(const pts: array of TPointF): ArrayOfTPointF;
194  {** Concatenates arrays of ''TPointF'' }
195  function ConcatPointsF(const APolylines: array of ArrayOfTPointF; AInsertEmptyPointInBetween: boolean = false): ArrayOfTPointF;
196  {** Compute the length of the polyline contained in the array.
197      ''AClosed'' specifies if the last point is to be joined to the first one }
198  function PolylineLen(const pts: array of TPointF; AClosed: boolean = false): single;
199
200type
201  {* A pen style can be dashed, dotted, etc. It is defined as a list of floating point number.
202     The first number is the length of the first dash,
203     the second number is the length of the first gap,
204     the third number is the length of the second dash...
205     It must have an even number of values. This is used as a complement
206     to [[BGRABitmap Types imported from Graphics|TPenStyle]] }
207  TBGRAPenStyle = array Of Single;
208
209  {** Creates a pen style with the specified length for the dashes and the spaces }
210  function BGRAPenStyle(dash1, space1: single; dash2: single=0; space2: single = 0; dash3: single=0; space3: single = 0; dash4 : single = 0; space4 : single = 0): TBGRAPenStyle;
211
212type
213  {* Different types of spline. A spline is a series of points that are used
214     as control points to draw a curve. The first point and last point may
215     or may not be the starting and ending point }
216  TSplineStyle = (
217    {** The curve is drawn inside the polygonal envelope without reaching the starting and ending points }
218    ssInside,
219    {** The curve is drawn inside the polygonal envelope and the starting and ending points are reached }
220    ssInsideWithEnds,
221    {** The curve crosses the polygonal envelope without reaching the starting and ending points }
222    ssCrossing,
223    {** The curve crosses the polygonal envelope and the starting and ending points are reached }
224    ssCrossingWithEnds,
225    {** The curve is outside the polygonal envelope (starting and ending points are reached) }
226    ssOutside,
227    {** The curve expands outside the polygonal envelope (starting and ending points are reached) }
228    ssRoundOutside,
229    {** The curve is outside the polygonal envelope and there is a tangeant at vertices (starting and ending points are reached) }
230    ssVertexToSide,
231    {** The curve is rounded using Bezier curves when the angle is less than or equal to 45° }
232    ssEasyBezier);
233
234type
235  {* Pointer to an arc definition }
236  PArcDef = ^TArcDef;
237  {* Definition of an arc of an ellipse }
238  TArcDef = record
239    {** Center of the ellipse }
240    center: TPointF;
241    {** Horizontal and vertical of the ellipse before rotation }
242    radius: TPointF;
243    {** Rotation of the ellipse }
244    xAngleRadCW: single;
245    {** Start and end angle, in radian and clockwise. See angle convention in ''BGRAPath'' }
246    startAngleRadCW, endAngleRadCW: single;
247    {** Specifies if the arc goes anticlockwise }
248    anticlockwise: boolean
249  end;
250
251  {** Creates a structure for an arc definition }
252  function ArcDef(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean) : TArcDef;
253
254type
255  {* Possible options for drawing an arc of an ellipse (used in ''BGRACanvas'') }
256  TArcOption = (
257    {** Close the path by joining the ending and starting point together }
258    aoClosePath,
259    {** Draw a pie shape by joining the ending and starting point to the center of the ellipse }
260    aoPie,
261    {** Fills the shape }
262    aoFillPath);
263    {** Set of options for drawing an arc }
264    TArcOptions = set of TArcOption;
265
266  TBGRAArrowStyle = (asNone, asNormal, asCut, asTriangle, asHollowTriangle, asFlipped, asFlippedCut, asTail, asTailRepeat);
267
268  { TBGRACustomArrow }
269
270  TBGRACustomArrow = class
271  protected
272    function GetEndOffsetX: single; virtual; abstract;
273    function GetEndRepeatCount: integer; virtual; abstract;
274    function GetEndSizeFactor: TPointF; virtual; abstract;
275    function GetIsEndDefined: boolean; virtual; abstract;
276    function GetIsStartDefined: boolean; virtual; abstract;
277    function GetStartOffsetX: single; virtual; abstract;
278    function GetStartRepeatCount: integer; virtual; abstract;
279    function GetStartSizeFactor: TPointF; virtual; abstract;
280    procedure SetEndOffsetX(AValue: single); virtual; abstract;
281    procedure SetEndRepeatCount(AValue: integer); virtual; abstract;
282    procedure SetEndSizeFactor(AValue: TPointF); virtual; abstract;
283    procedure SetStartOffsetX(AValue: single); virtual; abstract;
284    procedure SetStartRepeatCount(AValue: integer); virtual; abstract;
285    procedure SetStartSizeFactor(AValue: TPointF); virtual; abstract;
286    function GetLineCap: TPenEndCap; virtual; abstract;
287    procedure SetLineCap(AValue: TPenEndCap); virtual; abstract;
288  public
289    function ComputeStartAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF; virtual; abstract;
290    function ComputeEndAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF; virtual; abstract;
291    procedure StartAsNone; virtual; abstract;
292    procedure StartAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); virtual; abstract;
293    procedure StartAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); virtual; abstract;
294    procedure StartAsTail; virtual; abstract;
295    procedure EndAsNone; virtual; abstract;
296    procedure EndAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); virtual; abstract;
297    procedure EndAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); virtual; abstract;
298    procedure EndAsTail; virtual; abstract;
299    property IsStartDefined: boolean read GetIsStartDefined;
300    property IsEndDefined: boolean read GetIsEndDefined;
301    property StartOffsetX: single read GetStartOffsetX write SetStartOffsetX;
302    property EndOffsetX: single read GetEndOffsetX write SetEndOffsetX;
303    property LineCap: TPenEndCap read GetLineCap write SetLineCap;
304    property StartSize: TPointF read GetStartSizeFactor write SetStartSizeFactor;
305    property EndSize: TPointF read GetEndSizeFactor write SetEndSizeFactor;
306    property StartRepeatCount: integer read GetStartRepeatCount write SetStartRepeatCount;
307    property EndRepeatCount: integer read GetEndRepeatCount write SetEndRepeatCount;
308  end;
309
310  { TBGRACustomPenStroker }
311
312  TBGRACustomPenStroker = class
313  protected
314      function GetArrow: TBGRACustomArrow; virtual; abstract;
315      function GetArrowOwned: boolean; virtual; abstract;
316      function GetCustomPenStyle: TBGRAPenStyle; virtual; abstract;
317      function GetJoinStyle: TPenJoinStyle; virtual; abstract;
318      function GetLineCap: TPenEndCap; virtual; abstract;
319      function GetMiterLimit: single; virtual; abstract;
320      function GetPenStyle: TPenStyle; virtual; abstract;
321      function GetStrokeMatrix: TAffineMatrix; virtual; abstract;
322      procedure SetArrow(AValue: TBGRACustomArrow); virtual; abstract;
323      procedure SetArrowOwned(AValue: boolean); virtual; abstract;
324      procedure SetCustomPenStyle(AValue: TBGRAPenStyle); virtual; abstract;
325      procedure SetJoinStyle(AValue: TPenJoinStyle); virtual; abstract;
326      procedure SetLineCap(AValue: TPenEndCap); virtual; abstract;
327      procedure SetMiterLimit(AValue: single); virtual; abstract;
328      procedure SetPenStyle(AValue: TPenStyle); virtual; abstract;
329      procedure SetStrokeMatrix(const AValue: TAffineMatrix); virtual; abstract;
330  public
331      function ComputePolyline(const APoints: array of TPointF; AWidth: single; AClosedCap: boolean = true): ArrayOfTPointF; overload; virtual; abstract;
332      function ComputePolyline(const APoints: array of TPointF; AWidth: single; APenColor: TBGRAPixel; AClosedCap: boolean = true): ArrayOfTPointF; overload; virtual; abstract;
333      function ComputePolylineAutoCycle(const APoints: array of TPointF; AWidth: single): ArrayOfTPointF; virtual; abstract;
334      function ComputePolygon(const APoints: array of TPointF; AWidth: single): ArrayOfTPointF; virtual; abstract;
335      property Style: TPenStyle read GetPenStyle write SetPenStyle;
336      property CustomPenStyle: TBGRAPenStyle read GetCustomPenStyle write SetCustomPenStyle;
337      property Arrow: TBGRACustomArrow read GetArrow write SetArrow;
338      property ArrowOwned: boolean read GetArrowOwned write SetArrowOwned;
339      property StrokeMatrix: TAffineMatrix read GetStrokeMatrix write SetStrokeMatrix;
340      property LineCap: TPenEndCap read GetLineCap write SetLineCap;
341      property JoinStyle: TPenJoinStyle read GetJoinStyle write SetJoinStyle;
342      property MiterLimit: single read GetMiterLimit write SetMiterLimit;
343  end;
344
345type
346  {* Point in 3D with single-precision floating point coordinates }
347
348  PPoint3D = ^TPoint3D;
349
350  { TPoint3D }
351
352  TPoint3D = record
353    x,y,z: single;
354    procedure Offset(const point3D: TPoint3D);
355    procedure Scale(AScale: single);
356  end;
357
358  {----------------- Operators for TPoint3D ---------------}
359  {** Creates a new structure with values (''x'',''y'',''z'') }
360  function Point3D(x,y,z: single): TPoint3D;
361  {** Checks if all components ''x'', ''y'' and ''z'' are equal }
362  operator = (const v1,v2: TPoint3D): boolean; inline;
363  {** Adds components separately. It is like adding vectors }
364  operator + (const v1,v2: TPoint3D): TPoint3D; inline;
365  {** Subtract components separately. It is like subtracting vectors }
366  operator - (const v1,v2: TPoint3D): TPoint3D; inline;
367  {** Returns a point with opposite values for all components }
368  operator - (const v: TPoint3D): TPoint3D; inline;
369  {** Scalar product: multiplies components and returns the sum }
370  operator * (const v1,v2: TPoint3D): single; inline;
371  {** Multiplies components by ''factor''. It scales the vector represented by (''x'',''y'',''z'') }
372  operator * (const v1: TPoint3D; const factor: single): TPoint3D; inline;
373  {** Multiplies components by ''factor''. It scales the vector represented by (''x'',''y'',''z'') }
374  operator * (const factor: single; const v1: TPoint3D): TPoint3D; inline;
375  {** Computes the vectorial product ''w''. It is perpendicular to both ''u'' and ''v'' }
376  procedure VectProduct3D(u,v: TPoint3D; out w: TPoint3D);
377  {** Normalize the vector, i.e. scale it so that its length be 1 }
378  procedure Normalize3D(var v: TPoint3D); inline;
379  function VectLen3D(const v: TPoint3D): single;
380
381type
382  {* Defition of a line in the euclidian plane }
383  TLineDef = record
384    {** Some point in the line }
385    origin: TPointF;
386    {** Vector indicating the direction }
387    dir: TPointF;
388  end;
389
390  {----------- Line and polygon functions -----------}
391  {** Computes the intersection of two lines. If they are parallel, returns
392      the middle of the segment between the two origins }
393  function IntersectLine(line1, line2: TLineDef): TPointF; overload;
394  {** Computes the intersection of two lines. If they are parallel, returns
395      the middle of the segment between the two origins. The value ''parallel''
396      is set to indicate if the lines were parallel }
397  function IntersectLine(line1, line2: TLineDef; out parallel: boolean): TPointF; overload;
398  {** Checks if the polygon formed by the given points is convex. ''IgnoreAlign''
399      specifies that if the points are aligned, it should still be considered as convex }
400  function IsConvex(const pts: array of TPointF; IgnoreAlign: boolean = true): boolean;
401  function IsClockwise(const pts: array of TPointF): boolean;
402  {** Checks if the quad formed by the 4 given points intersects itself }
403  function DoesQuadIntersect(pt1,pt2,pt3,pt4: TPointF): boolean;
404  {** Checks if two segment intersect }
405  function DoesSegmentIntersect(pt1,pt2,pt3,pt4: TPointF): boolean;
406
407type
408  TBGRACustomPathCursor = class;
409  TBGRAPathDrawProc = procedure(const APoints: array of TPointF; AClosed: boolean; AData: Pointer) of object;
410  TBGRAPathFillProc = procedure(const APoints: array of TPointF; AData: pointer) of object;
411
412  {* A path is the ability to define a contour with ''moveTo'', ''lineTo''...
413     Even if it is an interface, it must not implement reference counting. }
414  IBGRAPath = interface
415    {** Closes the current path with a line to the starting point }
416    procedure closePath;
417    {** Moves to a location, disconnected from previous points }
418    procedure moveTo(constref pt: TPointF);
419    {** Adds a line from the current point }
420    procedure lineTo(constref pt: TPointF);
421    {** Adds a polyline from the current point }
422    procedure polylineTo(const pts: array of TPointF);
423    {** Adds a quadratic Bézier curve from the current point }
424    procedure quadraticCurveTo(constref cp,pt: TPointF);
425    {** Adds a cubic Bézier curve from the current point }
426    procedure bezierCurveTo(constref cp1,cp2,pt: TPointF);
427    {** Adds an arc. If there is a current point, it is connected to the beginning of the arc }
428    procedure arc(constref arcDef: TArcDef);
429    {** Adds an opened spline. If there is a current point, it is connected to the beginning of the spline }
430    procedure openedSpline(const pts: array of TPointF; style: TSplineStyle);
431    {** Adds an closed spline. If there is a current point, it is connected to the beginning of the spline }
432    procedure closedSpline(const pts: array of TPointF; style: TSplineStyle);
433    {** Copy the content of this path to the specified destination }
434    procedure copyTo(dest: IBGRAPath);
435    {** Returns the content of the path as an array of points }
436    function getPoints: ArrayOfTPointF; overload;
437    {** Returns the content of the path as an array of points with the transformation specified by ''AMatrix'' }
438    function getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF; overload;
439    {** Calls a given draw procedure for each sub path with computed coordinates for rendering }
440    procedure stroke(ADrawProc: TBGRAPathDrawProc; AData: pointer); overload;
441    procedure stroke(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AData: pointer); overload;
442    {** Calls a given fill procedure for each sub path with computed coordinates for rendering }
443    procedure fill(AFillProc: TBGRAPathFillProc; AData: pointer); overload;
444    procedure fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; AData: pointer); overload;
445    {** Returns a cursor to go through the path. The cursor must be freed by calling ''Free''. }
446    function getCursor: TBGRACustomPathCursor;
447  end;
448
449  { TBGRACustomPath }
450
451  TBGRACustomPath = class(IBGRAPath)
452    constructor Create; virtual; abstract;
453    procedure beginPath; virtual; abstract;
454    procedure closePath; virtual; abstract;
455    procedure moveTo(constref pt: TPointF); virtual; abstract;
456    procedure lineTo(constref pt: TPointF); virtual; abstract;
457    procedure polylineTo(const pts: array of TPointF); virtual; abstract;
458    procedure quadraticCurveTo(constref cp,pt: TPointF); virtual; abstract;
459    procedure bezierCurveTo(constref cp1,cp2,pt: TPointF); virtual; abstract;
460    procedure arc(constref arcDef: TArcDef); virtual; abstract;
461    procedure openedSpline(const pts: array of TPointF; style: TSplineStyle); virtual; abstract;
462    procedure closedSpline(const pts: array of TPointF; style: TSplineStyle); virtual; abstract;
463    procedure copyTo(dest: IBGRAPath); virtual; abstract;
464  protected
465    function getPoints: ArrayOfTPointF; overload; virtual; abstract;
466    function getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF; overload; virtual; abstract;
467    procedure stroke(ADrawProc: TBGRAPathDrawProc; AData: pointer); overload; virtual; abstract;
468    procedure stroke(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AData: pointer); overload; virtual; abstract;
469    procedure fill(AFillProc: TBGRAPathFillProc; AData: pointer); overload; virtual; abstract;
470    procedure fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; AData: pointer); overload; virtual; abstract;
471    function getLength: single; virtual; abstract;
472    function getCursor: TBGRACustomPathCursor; virtual; abstract;
473  protected
474    function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
475    function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
476    function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
477  end;
478
479  TBGRAPathAny = class of TBGRACustomPath;
480
481  { TBGRACustomPathCursor }
482  {* Class that contains a cursor to browse an existing path }
483  TBGRACustomPathCursor = class
484  protected
485    function GetArcPos: single; virtual; abstract;
486    function GetCurrentCoord: TPointF; virtual; abstract;
487    function GetCurrentTangent: TPointF; virtual; abstract;
488    function GetLoopClosedShapes: boolean; virtual; abstract;
489    function GetLoopPath: boolean; virtual; abstract;
490    function GetPathLength: single; virtual; abstract;
491    function GetBounds: TRectF; virtual; abstract;
492    function GetStartCoordinate: TPointF; virtual; abstract;
493    procedure SetArcPos(AValue: single); virtual; abstract;
494    procedure SetLoopClosedShapes(AValue: boolean); virtual; abstract;
495    procedure SetLoopPath(AValue: boolean); virtual; abstract;
496  public
497    {** Go forward in the path, increasing the value of ''Position''. If ''ADistance'' is negative, then
498        it goes backward instead. ''ACanJump'' specifies if the cursor can jump from one shape to another
499        without a line or an arc. Otherwise, the cursor is stuck, and the return value is less than
500        the value ''ADistance'' provided.  If all the way has been travelled, the
501        return value is equal to ''ADistance'' }
502    function MoveForward(ADistance: single; ACanJump: boolean = true): single; virtual; abstract;
503    {** Go backward, decreasing the value of ''Position''. If ''ADistance'' is negative, then it goes
504        forward instead. ''ACanJump'' specifies if the cursor can jump from one shape to another
505        without a line or an arc. Otherwise, the cursor is stuck, and the return value is less than
506        the value ''ADistance'' provided. If all the way has been travelled, the
507        return value is equal to ''ADistance'' }
508    function MoveBackward(ADistance: single; ACanJump: boolean = true): single; virtual; abstract;
509    {** Returns the current coordinate in the path }
510    property CurrentCoordinate: TPointF read GetCurrentCoord;
511    {** Returns the tangent vector. It is a vector of length one that is parallel to the curve
512        at the current point. A normal vector is easily deduced as PointF(y,-x) }
513    property CurrentTangent: TPointF read GetCurrentTangent;
514    {** Current position in the path, as a distance along the arc from the starting point of the path }
515    property Position: single read GetArcPos write SetArcPos;
516    {** Full arc length of the path }
517    property PathLength: single read GetPathLength;
518    {** Starting coordinate of the path }
519    property StartCoordinate: TPointF read GetStartCoordinate;
520    {** Specifies if the cursor loops when there is a closed shape }
521    property LoopClosedShapes: boolean read GetLoopClosedShapes write SetLoopClosedShapes;
522    {** Specifies if the cursor loops at the end of the path. Note that if it needs to jump to go
523        to the beginning, it will be only possible if the parameter ''ACanJump'' is set to True
524        when moving along the path }
525    property LoopPath: boolean read GetLoopPath write SetLoopPath;
526  end;
527
528var
529  BGRAPathFactory: TBGRAPathAny;
530
531const
532  {* A value for an empty rectangle }
533  EmptyRect : TRect = (left:0; top:0; right:0; bottom: 0);
534{* Checks if a point is in a rectangle. This follows usual convention: ''r.Right'' and
535  ''r.Bottom'' are not considered to be included in the rectangle. }
536function PtInRect(const pt: TPoint; r: TRect): boolean; overload;
537{* Creates a rectangle with the specified ''width'' and ''height'' }
538function RectWithSize(left,top,width,height: integer): TRect;
539
540{$DEFINE INCLUDE_INTERFACE}
541{$I bezier.inc}
542
543type
544  {* Possible options for a round rectangle }
545  TRoundRectangleOption = (
546    {** specify that a corner is a square (not rounded) }
547    rrTopLeftSquare,rrTopRightSquare,rrBottomRightSquare,rrBottomLeftSquare,
548    {** specify that a corner is a bevel (cut) }
549    rrTopLeftBevel,rrTopRightBevel,rrBottomRightBevel,rrBottomLeftBevel,
550    {** default option, does nothing particular }
551    rrDefault);
552    {** A set of options for a round rectangle }
553    TRoundRectangleOptions = set of TRoundRectangleOption;
554  {* Order of polygons when rendered using ''TBGRAMultiShapeFiller''
555     (in unit ''BGRAPolygon'') }
556  TPolygonOrder = (
557    {** No order, colors are mixed together }
558    poNone,
559    {** First polygon is on top }
560    poFirstOnTop,
561    {** Last polygon is on top }
562    poLastOnTop);
563
564  PIntersectionInfo = ^TIntersectionInfo;
565  { TIntersectionInfo }
566  {* Contains an intersection between an horizontal line and any shape. It
567     is used when filling shapes }
568  TIntersectionInfo = class
569    interX: single;
570    winding: integer;
571    numSegment: integer;
572    procedure SetValues(AInterX: Single; AWinding, ANumSegment: integer);
573  end;
574  {** An array of intersections between an horizontal line and any shape }
575  ArrayOfTIntersectionInfo = array of TIntersectionInfo;
576
577  {* Abstract class defining any shape that can be filled }
578  TBGRACustomFillInfo = class
579    public
580      {** Returns true if one segment number can represent a curve and
581          thus cannot be considered exactly straight }
582      function SegmentsCurved: boolean; virtual; abstract;
583
584      {** Returns integer bounds for the shape }
585      function GetBounds: TRect; virtual; abstract;
586
587      {** Check if the point is inside the shape }
588      function IsPointInside(x,y: single; windingMode: boolean): boolean; virtual; abstract;
589
590      {** Create an array that will contain computed intersections.
591          To augment that array, use ''CreateIntersectionInfo'' for new items }
592      function CreateIntersectionArray: ArrayOfTIntersectionInfo; virtual; abstract;
593      {** Create a structure to define one single intersection }
594      function CreateIntersectionInfo: TIntersectionInfo; virtual; abstract;
595      {** Free an array of intersections }
596      procedure FreeIntersectionArray(var inter: ArrayOfTIntersectionInfo); virtual; abstract;
597
598      {** Fill an array ''inter'' with actual intersections with the shape at the y coordinate ''cury''.
599          ''nbInter'' receives the number of computed intersections. ''windingMode'' specifies if
600          the winding method must be used to determine what is inside of the shape }
601      procedure ComputeAndSort(cury: single; var inter: ArrayOfTIntersectionInfo; out nbInter: integer; windingMode: boolean); virtual; abstract;
602
603      function GetSliceIndex: integer; virtual; abstract;
604  end;
605
606type
607  {* Shape of a gradient }
608  TGradientType = (
609    {** The color changes along a certain vector and does not change along its perpendicular direction }
610    gtLinear,
611    {** The color changes like in ''gtLinear'' however it is symmetrical to a specified direction }
612    gtReflected,
613    {** The color changes along a diamond shape }
614    gtDiamond,
615    {** The color changes in a radial way from a given center }
616    gtRadial,
617    {** The color changes according to the angle relative to a given center }
618    gtAngular);
619const
620  {** List of string to represent gradient types }
621  GradientTypeStr : array[TGradientType] of string
622  = ('Linear','Reflected','Diamond','Radial','Angular');
623  {** Returns the gradient type represented by the given string }
624  function StrToGradientType(str: string): TGradientType;
625
626type
627  TBGRAGradientGetColorAtFunc = function(position: integer): TBGRAPixel of object;
628  TBGRAGradientGetColorAtFloatFunc = function(position: single): TBGRAPixel of object;
629  TBGRAGradientGetExpandedColorAtFunc = function(position: integer): TExpandedPixel of object;
630  TBGRAGradientGetExpandedColorAtFloatFunc = function(position: single): TExpandedPixel of object;
631
632  { TBGRACustomGradient }
633  {* Defines a gradient of color, not specifying its shape but only the
634     series of colors }
635  TBGRACustomGradient = class
636  public
637    {** Returns the color at a given ''position''. The reference range is
638        from 0 to 65535, however values beyond are possible as well }
639    function GetColorAt(position: integer): TBGRAPixel; virtual; abstract;
640    function GetExpandedColorAt(position: integer): TExpandedPixel; virtual;
641    {** Returns the color at a given ''position''. The reference range is
642        from 0 to 1, however values beyond are possible as well }
643    function GetColorAtF(position: single): TBGRAPixel; virtual;
644    function GetExpandedColorAtF(position: single): TExpandedPixel; virtual;
645    {** Returns the average color of the gradient }
646    function GetAverageColor: TBGRAPixel; virtual; abstract;
647    function GetAverageExpandedColor: TExpandedPixel; virtual;
648    function GetMonochrome: boolean; virtual; abstract;
649    {** This property is True if the gradient contains only one color,
650        and thus is not really a gradient }
651    property Monochrome: boolean read GetMonochrome;
652  end;
653
654{$ENDIF}
655
656////////////////////////////////////////////////////////////////////////////////
657
658{$IFDEF INCLUDE_IMPLEMENTATION}
659{$UNDEF INCLUDE_IMPLEMENTATION}
660
661{$IFDEF BGRA_DEFINE_TRECTHELPER}
662{ TRectHelper }
663
664function TRectHelper.GetHeight: integer;
665begin
666  result := Bottom-Top;
667end;
668
669function TRectHelper.GetIsEmpty: boolean;
670begin
671  result := (Width = 0) and (Height = 0)
672end;
673
674function TRectHelper.GetWidth: integer;
675begin
676  result := Right-Left;
677end;
678
679procedure TRectHelper.SetHeight(AValue: integer);
680begin
681  Bottom := Top+AValue;
682end;
683
684procedure TRectHelper.SetWidth(AValue: integer);
685begin
686  Right := Left+AValue;
687end;
688
689constructor TRectHelper.Create(Origin: TPoint; AWidth, AHeight: Longint);
690begin
691  self.Left := Origin.X;
692  self.Top := Origin.Y;
693  self.Right := Origin.X+AWidth;
694  self.Bottom := Origin.Y+AHeight;
695end;
696
697constructor TRectHelper.Create(ALeft, ATop, ARight, ABottom: Longint);
698begin
699  self.Left := ALeft;
700  self.Top := ATop;
701  self.Right := ARight;
702  self.Bottom := ABottom;
703end;
704
705procedure TRectHelper.Intersect(R: TRect);
706begin
707  self := TRect.Intersect(self, R);
708end;
709
710class function TRectHelper.Intersect(R1: TRect; R2: TRect): TRect;
711begin
712  if R1.Left >= R2.Left then result.Left := R1.Left else result.Left := R2.Left;
713  if R1.Top >= R2.Top then result.Top := R1.Top else result.Top := R2.Top;
714  if R1.Right <= R2.Right then result.Right := R1.Right else result.Right := R2.Right;
715  if R1.Bottom <= R2.Bottom then result.Bottom := R1.Bottom else result.Bottom := R2.Bottom;
716  if result.IsEmpty then fillchar(result, sizeof(result), 0);
717end;
718
719function TRectHelper.IntersectsWith(R: TRect): Boolean;
720begin
721  Result := (Left < R.Right) and (R.Left < Right) and (Top < R.Bottom) and (R.Top < Bottom);
722end;
723
724class function TRectHelper.Union(R1, R2: TRect): TRect;
725begin
726  if R1.Left <= R2.Left then result.Left := R1.Left else result.Left := R2.Left;
727  if R1.Top <= R2.Top then result.Top := R1.Top else result.Top := R2.Top;
728  if R1.Right >= R2.Right then result.Right := R1.Right else result.Right := R2.Right;
729  if R1.Bottom >= R2.Bottom then result.Bottom := R1.Bottom else result.Bottom := R2.Bottom;
730  if result.IsEmpty then fillchar(result, sizeof(result), 0);
731end;
732
733procedure TRectHelper.Union(R: TRect);
734begin
735  self := TRect.Union(self, R);
736end;
737
738procedure TRectHelper.Offset(DX, DY: Longint);
739begin
740  Inc(Left, DX);
741  Inc(Top, DY);
742  Inc(Right, DX);
743  Inc(Bottom, DY);
744end;
745
746procedure TRectHelper.Inflate(DX, DY: Longint);
747begin
748  Dec(Left, DX);
749  Dec(Top, DY);
750  Inc(Right, DX);
751  Inc(Bottom, DY);
752end;
753
754function TRectHelper.Contains(const APoint: TPoint): boolean;
755begin
756  result := (APoint.X >= Left) and (APoint.X < Right) and
757    (APoint.Y >= Top) and (APoint.Y < Bottom);
758end;
759
760function TRectHelper.Contains(const ARect: TRect): boolean;
761begin
762  Result := (Left <= ARect.Left) and (ARect.Right <= Right) and (Top <= ARect.Top) and (ARect.Bottom <= Bottom);
763end;
764
765operator =(const ARect1, ARect2: TRect): boolean;
766begin
767  result:= (ARect1.Left = ARect2.Left) and (ARect1.Top = ARect2.Top) and
768           (ARect1.Right = ARect2.Right) and (ARect1.Bottom = ARect2.Bottom);
769end;
770{$ENDIF}
771
772{$ifdef BGRA_DEFINE_TSIZEHELPER}
773{ TSizeHelper }
774
775function TSizeHelper.GetHeight: integer;
776begin
777  result := cy;
778end;
779
780function TSizeHelper.GetWidth: integer;
781begin
782  result := cx;
783end;
784{$ENDIF}
785
786function IsEmptyPoint(const APoint: TPoint): boolean;
787begin
788  result := (APoint.x = -2147483648) or (APoint.y = -2147483648);
789end;
790
791procedure TPointFHelper.Offset(const apt: TPointF);
792begin
793  if isEmptyPointF(self) then exit;
794  IncF(self.x, apt.x);
795  IncF(self.y, apt.y);
796end;
797
798procedure TPointFHelper.Offset(const apt: TPoint);
799begin
800  if isEmptyPointF(self) then exit;
801  IncF(self.x, apt.x);
802  IncF(self.y, apt.y);
803end;
804
805procedure TPointFHelper.Offset(dx, dy: longint);
806begin
807  if isEmptyPointF(self) then exit;
808  IncF(self.x, dx);
809  IncF(self.y, dy);
810end;
811
812procedure TPointFHelper.Offset(dx, dy: single);
813begin
814  if isEmptyPointF(self) then exit;
815  IncF(self.x, dx);
816  IncF(self.y, dy);
817end;
818
819procedure TPointFHelper.Scale(AScale: single);
820begin
821  if not isEmptyPointF(self) then
822  begin
823    self.x := self.x * AScale;
824    self.y := self.y * AScale;
825  end;
826end;
827
828procedure TPointFHelper.Normalize;
829var
830  len: Single;
831begin
832  len := Length;
833  if len > 0 then self := self*(1/len);
834end;
835
836function TPointFHelper.Ceiling: TPoint;
837begin
838  if isEmptyPointF(self) then
839    result := EmptyPoint
840  else
841  begin
842    result.x:=ceil(x);
843    result.y:=ceil(y);
844  end;
845end;
846
847function TPointFHelper.Truncate: TPoint;
848begin
849  if isEmptyPointF(self) then
850    result := EmptyPoint
851  else
852  begin
853    result.x:=trunc(x);
854    result.y:=trunc(y);
855  end;
856end;
857
858function TPointFHelper.Floor: TPoint;
859begin
860  if isEmptyPointF(self) then
861    result := EmptyPoint
862  else
863  begin
864    result.x:=Math.floor(x);
865    result.y:=Math.floor(y);
866  end;
867end;
868
869function TPointFHelper.Round: TPoint;
870begin
871  if isEmptyPointF(self) then
872    result := EmptyPoint
873  else
874  begin
875    result.x:=System.round(x);
876    result.y:=System.round(y);
877  end;
878end;
879
880function TPointFHelper.Length: Single;
881begin
882  result:= VectLen(self);
883end;
884
885function TPointFHelper.IsEmpty: boolean;
886begin
887  result := isEmptyPointF(self);
888end;
889
890class function TRectFHelper.Intersect(const R1: TRectF; const R2: TRectF): TRectF;
891begin
892  result.left:=max(R1.left,R2.left);
893  result.top:=max(R1.top,R2.top);
894  result.right:=min(R1.right,R2.right);
895  result.bottom:=min(R1.bottom,R2.bottom);
896  if (result.left >= result.right) or (result.top >= result.bottom) then
897    result := EmptyRectF;
898end;
899
900class function TRectFHelper.Union(const R1: TRectF; const R2: TRectF): TRectF;
901begin
902  result.left:=min(R1.left,R2.left);
903  result.top:=min(R1.top,R2.top);
904  result.right:=max(R1.right,R2.right);
905  result.bottom:=max(R1.bottom,R2.bottom);
906end;
907
908class function TRectFHelper.Union(const R1: TRectF; const R2: TRectF; ADiscardEmpty: boolean): TRectF;
909begin
910  if ADiscardEmpty and IsEmptyRectF(R1) then result:= R2 else
911  if ADiscardEmpty and IsEmptyRectF(R2) then result:= R1 else
912    result := Union(R1,R2);
913end;
914
915function TRectFHelper.Union(const r: TRectF): TRectF;
916begin
917  result := TRectF.Union(self, r);
918end;
919
920function TRectFHelper.Union(const r: TRectF; ADiscardEmpty: boolean): TRectF;
921begin
922  result := TRectF.Union(self, r, ADiscardEmpty);
923end;
924
925procedure TRectFHelper.Include(const APoint: TPointF);
926begin
927  if APoint.x <> EmptySingle then
928  begin
929    if APoint.x < Left then Left := APoint.x else
930    if APoint.x > Right then Right := APoint.x;
931  end;
932  if APoint.y <> EmptySingle then
933  begin
934    if APoint.y < Top then Top := APoint.y else
935    if APoint.y > Bottom then Bottom := APoint.y;
936  end;
937end;
938
939function TRectFHelper.Contains(const APoint: TPointF;
940  AIncludeBottomRight: boolean): boolean;
941begin
942  if isEmptyPointF(APoint) then result := false else
943  if (APoint.x < Left) or (APoint.y < Top) then result := false else
944  if AIncludeBottomRight and ((APoint.x > Right) or (APoint.y > Bottom)) then result := false else
945  if not AIncludeBottomRight and ((APoint.x >= Right) or (APoint.y >= Bottom)) then result := false
946  else result := true;
947end;
948
949function TRectFHelper.IntersectsWith(const r: TRectF): boolean;
950begin
951  result:= not TRectF.Intersect(self, r).IsEmpty;
952end;
953
954function TRectFHelper.IsEmpty: boolean;
955begin
956  result:= IsEmptyRectF(self);
957end;
958
959{ TAffineBox }
960
961function TAffineBox.GetAsPolygon: ArrayOfTPointF;
962begin
963  result := PointsF([TopLeft,TopRight,BottomRight,BottomLeft]);
964end;
965
966function TAffineBox.GetBottomRight: TPointF;
967begin
968  if IsEmpty then
969    result := EmptyPointF
970  else
971    result := TopRight + (BottomLeft-TopLeft);
972end;
973
974function TAffineBox.GetCenter: TPointF;
975begin
976  result := (TopLeft + BottomRight)*0.5;
977end;
978
979function TAffineBox.GetHeight: single;
980begin
981  if isEmptyPointF(TopLeft) or isEmptyPointF(BottomLeft) then
982    result := 0
983  else
984    result := VectLen(BottomLeft-TopLeft);
985end;
986
987function TAffineBox.GetIsEmpty: boolean;
988begin
989  result := isEmptyPointF(TopRight) or isEmptyPointF(BottomLeft) or isEmptyPointF(TopLeft);
990end;
991
992function TAffineBox.GetRectBounds: TRect;
993begin
994  with GetRectBoundsF do
995    result := Rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom));
996end;
997
998function TAffineBox.GetRectBoundsF: TRectF;
999var
1000  x1,y1,x2,y2: single;
1001begin
1002  x1 := TopLeft.x; x2 := x1;
1003  y1 := TopLeft.y; y2 := y1;
1004  if TopRight.x > x2 then x2 := TopRight.x;
1005  if TopRight.x < x1 then x1 := TopRight.x;
1006  if TopRight.y > y2 then y2 := TopRight.y;
1007  if TopRight.y < y1 then y1 := TopRight.y;
1008  if BottomLeft.x > x2 then x2 := BottomLeft.x;
1009  if BottomLeft.x < x1 then x1 := BottomLeft.x;
1010  if BottomLeft.y > y2 then y2 := BottomLeft.y;
1011  if BottomLeft.y < y1 then y1 := BottomLeft.y;
1012  if BottomRight.x > x2 then x2 := BottomRight.x;
1013  if BottomRight.x < x1 then x1 := BottomRight.x;
1014  if BottomRight.y > y2 then y2 := BottomRight.y;
1015  if BottomRight.y < y1 then y1 := BottomRight.y;
1016  result := RectF(x1,y1,x2,y2);
1017end;
1018
1019function TAffineBox.GetSurface: single;
1020var
1021  u, v: TPointF;
1022  lenU, lenH: Single;
1023begin
1024  u := TopRight-TopLeft;
1025  lenU := VectLen(u);
1026  if lenU = 0 then exit(0);
1027  u.Scale(1/lenU);
1028  v := BottomLeft-TopLeft;
1029  lenH := PointF(-u.y,u.x)*v;
1030  result := abs(lenU*lenH);
1031end;
1032
1033function TAffineBox.GetWidth: single;
1034begin
1035  if isEmptyPointF(TopLeft) or isEmptyPointF(TopRight) then
1036    result := 0
1037  else
1038    result := VectLen(TopRight-TopLeft);
1039end;
1040
1041class function TAffineBox.EmptyBox: TAffineBox;
1042begin
1043  result.TopLeft := EmptyPointF;
1044  result.TopRight := EmptyPointF;
1045  result.BottomLeft := EmptyPointF;
1046end;
1047
1048class function TAffineBox.AffineBox(ATopLeft, ATopRight, ABottomLeft: TPointF): TAffineBox;
1049begin
1050  result.TopLeft := ATopLeft;
1051  result.TopRight := ATopRight;
1052  result.BottomLeft := ABottomLeft;
1053end;
1054
1055class function TAffineBox.AffineBox(ARectF: TRectF): TAffineBox;
1056begin
1057  result.TopLeft := ARectF.TopLeft;
1058  result.TopRight := PointF(ARectF.Right, ARectF.Top);
1059  result.BottomLeft := PointF(ARectF.Left, ARectF.Bottom);
1060end;
1061
1062procedure TAffineBox.Offset(AOfsX, AOfsY: single);
1063begin
1064  TopLeft.Offset(AOfsX,AOfsY);
1065  TopRight.Offset(AOfsX,AOfsY);
1066  BottomLeft.Offset(AOfsX,AOfsY);
1067end;
1068
1069procedure TAffineBox.Offset(AOfs: TPointF);
1070begin
1071  Offset(AOfs.X,AOfs.Y);
1072end;
1073
1074procedure TAffineBox.Inflate(AHoriz, AVert: single);
1075var
1076  u, v, ofs_horiz, ofs_vert: TPointF;
1077  lenU, lenV: Single;
1078begin
1079  u := TopRight-TopLeft;
1080  v := BottomLeft-TopLeft;
1081  lenU := VectLen(u);
1082  if lenU > 0 then u := u*(1/lenU);
1083  lenV := VectLen(v);
1084  if lenV > 0 then v := v*(1/lenV);
1085  ofs_horiz := u*AHoriz;
1086  ofs_vert := v*AVert;
1087  TopLeft := TopLeft - ofs_horiz - ofs_vert;
1088  TopRight := TopRight + ofs_horiz - ofs_vert;
1089  BottomLeft := BottomLeft - ofs_horiz + ofs_vert;
1090end;
1091
1092function TAffineBox.Contains(APoint: TPointF): boolean;
1093var
1094  u,v,perpU,perpV: TPointF;
1095  posV1, posV2, posU1, posU2: single;
1096begin
1097  if IsEmpty then exit(false);
1098
1099  u := TopRight-TopLeft;
1100  perpU := PointF(-u.y,u.x);
1101  v := BottomLeft-TopLeft;
1102  perpV := PointF(v.y,-v.x);
1103
1104  //reverse normal if not in the same direction as other side
1105  if perpU*v < 0 then
1106  begin
1107    perpU := -perpU;
1108    perpV := -perpV;
1109  end;
1110
1111  //determine position along normals
1112  posU1 := (APoint-TopLeft)*perpU;
1113  posU2 := (APoint-BottomLeft)*perpU;
1114  posV1 := (APoint-TopLeft)*perpV;
1115  posV2 := (APoint-TopRight)*perpV;
1116
1117  result := (posU1 >= 0) and (posU2 < 0) and (posV1 >= 0) and (posV2 < 0);
1118end;
1119
1120function StrToGradientType(str: string): TGradientType;
1121var gt: TGradientType;
1122begin
1123  result := gtLinear;
1124  str := LowerCase(str);
1125  for gt := low(TGradientType) to high(TGradientType) do
1126    if str = LowerCase(GradientTypeStr[gt]) then
1127    begin
1128      result := gt;
1129      exit;
1130    end;
1131end;
1132
1133{ TBGRACustomGradient }
1134
1135function TBGRACustomGradient.GetExpandedColorAt(position: integer
1136  ): TExpandedPixel;
1137begin
1138  result := GammaExpansion(GetColorAt(position));
1139end;
1140
1141function TBGRACustomGradient.GetColorAtF(position: single): TBGRAPixel;
1142begin
1143  if position = EmptySingle then exit(BGRAPixelTransparent);
1144  position := position * 65536;
1145  if position < low(integer) then
1146    result := GetColorAt(low(Integer))
1147  else if position > high(integer) then
1148    result := GetColorAt(high(Integer))
1149  else
1150    result := GetColorAt(round(position));
1151end;
1152
1153function TBGRACustomGradient.GetExpandedColorAtF(position: single): TExpandedPixel;
1154begin
1155  if position = EmptySingle then exit(BGRAPixelTransparent);
1156  position := position * 65536;
1157  if position < low(integer) then
1158    result := GetExpandedColorAt(low(Integer))
1159  else if position > high(integer) then
1160    result := GetExpandedColorAt(high(Integer))
1161  else
1162    result := GetExpandedColorAt(round(position));
1163end;
1164
1165function TBGRACustomGradient.GetAverageExpandedColor: TExpandedPixel;
1166begin
1167  result := GammaExpansion(GetAverageColor);
1168end;
1169
1170{ TIntersectionInfo }
1171
1172procedure TIntersectionInfo.SetValues(AInterX: Single; AWinding,
1173  ANumSegment: integer);
1174begin
1175  interX := AInterX;
1176  winding := AWinding;
1177  numSegment := ANumSegment;
1178end;
1179
1180{********************** TRect functions **************************}
1181
1182function PtInRect(const pt: TPoint; r: TRect): boolean;
1183var
1184  temp: integer;
1185begin
1186  if r.right < r.left then
1187  begin
1188    temp    := r.left;
1189    r.left  := r.right;
1190    r.Right := temp;
1191  end;
1192  if r.bottom < r.top then
1193  begin
1194    temp     := r.top;
1195    r.top    := r.bottom;
1196    r.bottom := temp;
1197  end;
1198  Result := (pt.X >= r.left) and (pt.Y >= r.top) and (pt.X < r.right) and
1199    (pt.y < r.bottom);
1200end;
1201
1202function RectWithSize(left, top, width, height: integer): TRect;
1203begin
1204  result.left := left;
1205  result.top := top;
1206  result.right := left+width;
1207  result.bottom := top+height;
1208end;
1209
1210{ Make a pen style. Need an even number of values. See TBGRAPenStyle }
1211function BGRAPenStyle(dash1, space1: single; dash2: single; space2: single;
1212  dash3: single; space3: single; dash4: single; space4: single): TBGRAPenStyle;
1213var
1214  i: Integer;
1215begin
1216  if dash4 <> 0 then
1217  begin
1218    setlength(result,8);
1219    result[6] := dash4;
1220    result[7] := space4;
1221    result[4] := dash3;
1222    result[5] := space3;
1223    result[2] := dash2;
1224    result[3] := space2;
1225  end else
1226  if dash3 <> 0 then
1227  begin
1228    setlength(result,6);
1229    result[4] := dash3;
1230    result[5] := space3;
1231    result[2] := dash2;
1232    result[3] := space2;
1233  end else
1234  if dash2 <> 0 then
1235  begin
1236    setlength(result,4);
1237    result[2] := dash2;
1238    result[3] := space2;
1239  end else
1240  begin
1241    setlength(result,2);
1242  end;
1243  result[0] := dash1;
1244  result[1] := space1;
1245  for i := 0 to high(result) do
1246    if result[i]=0 then
1247      raise exception.Create('Zero is not a valid value');
1248end;
1249
1250{ TBGRACustomPath }
1251
1252function TBGRACustomPath.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
1253begin
1254  if GetInterface(iid, obj) then
1255    Result := S_OK
1256  else
1257    Result := longint(E_NOINTERFACE);
1258end;
1259
1260{ There is no automatic reference counting, but it is compulsory to define these functions }
1261function TBGRACustomPath._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
1262begin
1263  result := 0;
1264end;
1265
1266function TBGRACustomPath._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
1267begin
1268  result := 0;
1269end;
1270
1271function ArcDef(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single;
1272  anticlockwise: boolean): TArcDef;
1273begin
1274  result.center := PointF(cx,cy);
1275  result.radius := PointF(rx,ry);
1276  result.xAngleRadCW:= xAngleRadCW;
1277  result.startAngleRadCW := startAngleRadCW;
1278  result.endAngleRadCW:= endAngleRadCW;
1279  result.anticlockwise:= anticlockwise;
1280end;
1281
1282{----------------- Operators for TPoint3D ---------------}
1283operator = (const v1, v2: TPoint3D): boolean; inline;
1284begin
1285  result := (v1.x=v2.x) and (v1.y=v2.y) and (v1.z=v2.z);
1286end;
1287
1288operator * (const v1,v2: TPoint3D): single; inline;
1289begin
1290  result := v1.x*v2.x + v1.y*v2.y + v1.z*v2.z;
1291end;
1292
1293operator * (const v1: TPoint3D; const factor: single): TPoint3D; inline;
1294begin
1295  result.x := v1.x*factor;
1296  result.y := v1.y*factor;
1297  result.z := v1.z*factor;
1298end;
1299
1300operator - (const v1,v2: TPoint3D): TPoint3D; inline;
1301begin
1302  result.x := v1.x-v2.x;
1303  result.y := v1.y-v2.y;
1304  result.z := v1.z-v2.z;
1305end;
1306
1307operator -(const v: TPoint3D): TPoint3D; inline;
1308begin
1309  result.x := -v.x;
1310  result.y := -v.y;
1311  result.z := -v.z;
1312end;
1313
1314operator + (const v1,v2: TPoint3D): TPoint3D; inline;
1315begin
1316  result.x := v1.x+v2.x;
1317  result.y := v1.y+v2.y;
1318  result.z := v1.z+v2.z;
1319end;
1320
1321operator*(const factor: single; const v1: TPoint3D): TPoint3D;
1322begin
1323  result.x := v1.x*factor;
1324  result.y := v1.y*factor;
1325  result.z := v1.z*factor;
1326end;
1327
1328{ TPoint3D }
1329
1330procedure TPoint3D.Offset(const point3D: TPoint3D);
1331begin
1332  IncF(self.x, point3d.x);
1333  IncF(self.y, point3d.y);
1334  IncF(self.z, point3d.z);
1335end;
1336
1337procedure TPoint3D.Scale(AScale: single);
1338begin
1339  self.x := self.x * AScale;
1340  self.y := self.y * AScale;
1341  self.z := self.z * AScale;
1342end;
1343
1344function Point3D(x, y, z: single): TPoint3D;
1345begin
1346  result.x := x;
1347  result.y := y;
1348  result.z := z;
1349end;
1350
1351procedure Normalize3D(var v: TPoint3D); inline;
1352var len: double;
1353begin
1354  len := v*v;
1355  if len = 0 then exit;
1356  len := sqrt(len);
1357  v.x := v.x / len;
1358  v.y := v.y / len;
1359  v.z := v.z / len;
1360end;
1361
1362function VectLen3D(const v: TPoint3D): single;
1363begin
1364  result := sqrt(v.x*v.x + v.y*v.y + v.z*v.z);
1365end;
1366
1367procedure VectProduct3D(u,v: TPoint3D; out w: TPoint3D);
1368begin
1369  w.x := u.y*v.z-u.z*v.y;
1370  w.y := u.z*v.x-u.x*v.z;
1371  w.z := u.x*v.Y-u.y*v.x;
1372end;
1373
1374{----------------- Operators for TPointF --------------------}
1375operator =(const pt1, pt2: TPointF): boolean;
1376begin
1377  result := (pt1.x = pt2.x) and (pt1.y = pt2.y);
1378end;
1379
1380operator -(const pt1, pt2: TPointF): TPointF;
1381begin
1382  result.x := pt1.x-pt2.x;
1383  result.y := pt1.y-pt2.y;
1384end;
1385
1386operator -(const pt2: TPointF): TPointF;
1387begin
1388  result.x := -pt2.x;
1389  result.y := -pt2.y;
1390end;
1391
1392operator +(const pt1, pt2: TPointF): TPointF;
1393begin
1394  result.x := pt1.x+pt2.x;
1395  result.y := pt1.y+pt2.y;
1396end;
1397
1398operator *(const pt1, pt2: TPointF): single;
1399begin
1400  result := pt1.x*pt2.x + pt1.y*pt2.y;
1401end;
1402
1403operator *(const pt1: TPointF; factor: single): TPointF;
1404begin
1405  result.x := pt1.x*factor;
1406  result.y := pt1.y*factor;
1407end;
1408
1409operator *(factor: single; const pt1: TPointF): TPointF;
1410begin
1411  result.x := pt1.x*factor;
1412  result.y := pt1.y*factor;
1413end;
1414
1415function RectF(Left, Top, Right, Bottom: Single): TRectF;
1416begin
1417  result.Left:= Left;
1418  result.Top:= Top;
1419  result.Right:= Right;
1420  result.Bottom:= Bottom;
1421end;
1422
1423function RectF(const ATopLeft, ABottomRight: TPointF): TRectF;
1424begin
1425  result.TopLeft:= ATopLeft;
1426  result.BottomRight:= ABottomRight;
1427end;
1428
1429function RectF(const ARect: TRect): TRectF;
1430begin
1431  result.Left := ARect.Left;
1432  result.Top := ARect.Top;
1433  result.Right := ARect.Right;
1434  result.Bottom := ARect.Bottom;
1435end;
1436
1437function RectWithSizeF(left, top, width, height: Single): TRectF;
1438begin
1439  result.Left:= Left;
1440  result.Top:= Top;
1441  result.Right:= left+width;
1442  result.Bottom:= top+height;
1443end;
1444
1445function IsEmptyRectF(const ARect: TRectF): boolean;
1446begin
1447  result:= (ARect.Width = 0) and (ARect.Height = 0);
1448end;
1449
1450function PointF(x, y: single): TPointF;
1451begin
1452  Result.x := x;
1453  Result.y := y;
1454end;
1455
1456function PointF(pt: TPoint): TPointF;
1457begin
1458  if IsEmptyPoint(pt) then
1459    result:= EmptyPointF
1460  else
1461  begin
1462    Result.x := pt.x;
1463    Result.y := pt.y;
1464  end;
1465end;
1466
1467function PointsF(const pts: array of TPointF): ArrayOfTPointF;
1468var
1469  i: Integer;
1470begin
1471  setlength(result, length(pts));
1472  for i := 0 to high(pts) do result[i] := pts[i];
1473end;
1474
1475function ConcatPointsF(const APolylines: array of ArrayOfTPointF;
1476  AInsertEmptyPointInBetween: boolean): ArrayOfTPointF;
1477var
1478  i,pos,count:integer;
1479  j: Integer;
1480begin
1481  count := 0;
1482  for i := 0 to high(APolylines) do
1483    inc(count,length(APolylines[i]));
1484  if AInsertEmptyPointInBetween then inc(count, length(APolylines)-1);
1485  setlength(result,count);
1486  pos := 0;
1487  for i := 0 to high(APolylines) do
1488  begin
1489    if AInsertEmptyPointInBetween and (i > 0) then
1490    begin
1491      result[pos] := EmptyPointF;
1492      inc(pos);
1493    end;
1494    for j := 0 to high(APolylines[i]) do
1495    begin
1496      result[pos] := APolylines[i][j];
1497      inc(pos);
1498    end;
1499  end;
1500end;
1501
1502function VectLen(v: TPointF): single;
1503begin
1504  if isEmptyPointF(v) then
1505    result := EmptySingle
1506  else
1507    result := sqrt(v*v);
1508end;
1509
1510function VectDet(v1, v2: TPointF): double;
1511begin
1512  result := v1.x*v2.y - v1.y*v2.x;
1513end;
1514
1515function VectLen(dx, dy: single): single;
1516begin
1517  result := sqrt(dx*dx+dy*dy);
1518end;
1519
1520function PolylineLen(const pts: array of TPointF; AClosed: boolean): single;
1521var
1522  i: Int32or64;
1523begin
1524  result := 0;
1525  for i := 0 to high(pts)-1 do
1526    IncF(result, VectLen(pts[i+1] - pts[i]) );
1527  if AClosed then
1528    incF(result, VectLen(pts[0] - pts[high(pts)]) );
1529end;
1530
1531{ Check if a PointF structure is empty or should be treated as a list separator }
1532function isEmptyPointF(const pt: TPointF): boolean;
1533begin
1534  Result := (pt.x = EmptySingle) and (pt.y = EmptySingle);
1535end;
1536
1537{----------- Line and polygon functions -----------}
1538{$PUSH}{$OPTIMIZATION OFF}
1539function IntersectLine(line1, line2: TLineDef): TPointF;
1540var parallel: boolean;
1541begin
1542  result := IntersectLine(line1,line2,parallel);
1543end;
1544{$POP}
1545
1546function IntersectLine(line1, line2: TLineDef; out parallel: boolean): TPointF;
1547  procedure SetParallel;
1548  begin
1549    parallel := true;
1550    //return the center of the segment between line origins
1551    result.x := (line1.origin.x+line2.origin.x)/2;
1552    result.y := (line1.origin.y+line2.origin.y)/2;
1553  end;
1554var pos, step: single;
1555  n: TPointF;
1556begin
1557  parallel := false;
1558  n := PointF(-line2.dir.y, line2.dir.x);
1559  step := line1.dir*n;
1560  if step = 0 then begin SetParallel; exit; end;
1561  pos := (line2.origin - line1.origin)*n;
1562  result := line1.origin + line1.dir * (pos/step);
1563end;
1564
1565{ Check if a polygon is convex, i.e. it always turns in the same direction }
1566function IsConvex(const pts: array of TPointF; IgnoreAlign: boolean = true): boolean;
1567var
1568  positive,negative,zero: boolean;
1569  product: single;
1570  i: Integer;
1571begin
1572  positive := false;
1573  negative := false;
1574  zero := false;
1575  for i := 0 to high(pts) do
1576  begin
1577    product := (pts[(i+1) mod length(pts)].x-pts[i].x)*(pts[(i+2) mod length(pts)].y-pts[i].y) -
1578               (pts[(i+1) mod length(pts)].y-pts[i].y)*(pts[(i+2) mod length(pts)].x-pts[i].x);
1579    if product > 0 then
1580    begin
1581      if negative then
1582      begin
1583        result := false;
1584        exit;
1585      end;
1586      positive := true;
1587    end else
1588    if product < 0 then
1589    begin
1590      if positive then
1591      begin
1592        result := false;
1593        exit;
1594      end;
1595      negative := true;
1596    end else
1597      zero := true;
1598  end;
1599  if not IgnoreAlign and zero then
1600    result := false
1601  else
1602    result := true;
1603end;
1604
1605{ Check if two segments intersect }
1606function DoesSegmentIntersect(pt1,pt2,pt3,pt4: TPointF): boolean;
1607var
1608  seg1: TLineDef;
1609  seg1len: single;
1610  seg2: TLineDef;
1611  seg2len: single;
1612  inter: TPointF;
1613  pos1,pos2: single;
1614  para: boolean;
1615
1616begin
1617  { Determine line definitions }
1618  seg1.origin := pt1;
1619  seg1.dir := pt2-pt1;
1620  seg1len := VectLen(seg1.dir);
1621  if seg1len = 0 then
1622  begin
1623    result := false;
1624    exit;
1625  end;
1626  seg1.dir.Scale(1/seg1len);
1627
1628  seg2.origin := pt3;
1629  seg2.dir := pt4-pt3;
1630  seg2len := VectLen(seg2.dir);
1631  if seg2len = 0 then
1632  begin
1633    result := false;
1634    exit;
1635  end;
1636  seg2.dir.Scale(1/seg2len);
1637
1638  //obviously parallel
1639  if seg1.dir = seg2.dir then
1640    result := false
1641  else
1642  begin
1643    //try to compute intersection
1644    inter := IntersectLine(seg1,seg2,para);
1645    if para then
1646      result := false
1647    else
1648    begin
1649      //check if intersections are inside the segments
1650      pos1 := (inter-seg1.origin)*seg1.dir;
1651      pos2 := (inter-seg2.origin)*seg2.dir;
1652      if (pos1 >= 0) and (pos1 <= seg1len) and
1653         (pos2 >= 0) and (pos2 <= seg2len) then
1654        result := true
1655      else
1656        result := false;
1657    end;
1658  end;
1659end;
1660
1661function IsClockwise(const pts: array of TPointF): boolean;
1662var
1663  i: Integer;
1664begin
1665  for i := 0 to high(pts) do
1666  begin
1667    if (pts[(i+1) mod length(pts)].x-pts[i].x)*(pts[(i+2) mod length(pts)].y-pts[i].y) -
1668       (pts[(i+1) mod length(pts)].y-pts[i].y)*(pts[(i+2) mod length(pts)].x-pts[i].x) < 0 then
1669    begin
1670       result := false;
1671       exit;
1672    end;
1673  end;
1674  result := true;
1675end;
1676
1677{ Check if a quaduadrilateral intersects itself }
1678function DoesQuadIntersect(pt1,pt2,pt3,pt4: TPointF): boolean;
1679begin
1680  result := DoesSegmentIntersect(pt1,pt2,pt3,pt4) or DoesSegmentIntersect(pt2,pt3,pt4,pt1);
1681end;
1682
1683{$DEFINE INCLUDE_IMPLEMENTATION}
1684{$I bezier.inc}
1685
1686{$ENDIF}
1687