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