source: trunk/Packages/bgrabitmap/geometrytypes.inc

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