Ignore:
Timestamp:
Apr 17, 2019, 12:58:41 AM (5 years ago)
Author:
chronos
Message:
  • Modified: Propagate project build mode options to used packages.
  • Added: Check memory leaks using heaptrc.
  • Modified: Update BGRABitmap package.
Location:
GraphicTest
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest

    • Property svn:ignore

      •  

        old new  
        88GraphicTest.lps
        99GraphicTest.dbg
         10heaptrclog.trc

  • GraphicTest/Packages/bgrabitmap/geometrytypes.inc

    r494 r521  
    1919  {$endif}
    2020
     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 }
    2125  TAffineMatrix = array[1..2,1..3] of single;
    2226
    … …  
    2428  TRectF = Types.TRectF;
    2529  {$else}
     30  {$define BGRA_DEFINE_TRECTF}
     31  { TRectF }
     32
    2633  TRectF =
    2734  {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
    … …  
    2936  {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    3037  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);
    3145    case Integer of
    3246     0: (Left, Top, Right, Bottom: Single);
    3347     1: (TopLeft, BottomRight: TPointF);
    3448  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
    3586  {$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
    36121  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;
    37155
    38156  const
    … …  
    43161  {----------------- Operators for TPointF --------------------}
    44162  {** Creates a new structure with values ''x'' and ''y'' }
    45   function PointF(x, y: single): TPointF;
     163  function PointF(x, y: single): TPointF; overload;
     164  function PointF(pt: TPoint): TPointF; overload;
    46165  {** Checks if the structure is empty (equal to ''EmptyPointF'') }
    47166  function isEmptyPointF(const pt: TPointF): boolean;
    … …  
    68187type
    69188  TFaceCulling = (fcNone, fcKeepCW, fcKeepCCW);
    70   {* Contains an array of points with single-precision floating point coordinates }
    71   ArrayOfTPointF = array of TPointF;
    72189
    73190  {** Creates an array of ''TPointF'' }
    … …  
    109226    ssRoundOutside,
    110227    {** The curve is outside the polygonal envelope and there is a tangeant at vertices (starting and ending points are reached) }
    111     ssVertexToSide);
    112 
    113   { TCubicBezierCurve }
    114   {* Definition of a Bézier curve of order 3. It has two control points ''c1'' and ''c2''. Those are not reached by the curve }
    115   TCubicBezierCurve = object
    116   private
    117     function SimpleComputePoints(AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF;
    118   public
    119     {** Starting point (reached) }
    120     p1: TPointF;
    121     {** First control point (not reached by the curve) }
    122     c1: TPointF;
    123     {** Second control point (not reached by the curve) }
    124     c2: TPointF;
    125     {** Ending point (reached) }
    126     p2: TPointF;
    127     {** Computes the point at time ''t'', varying from 0 to 1 }
    128     function ComputePointAt(t: single): TPointF;
    129     {** Split the curve in two such that ''ALeft.p2'' = ''ARight.p1'' }
    130     procedure Split(out ALeft, ARight: TCubicBezierCurve);
    131     {** Compute an approximation of the length of the curve. ''AAcceptedDeviation'' indicates the
    132        maximum orthogonal distance that is ignored and approximated by a straight line. }
    133     function ComputeLength(AAcceptedDeviation: single = 0.1): single;
    134     {** Computes a polygonal approximation of the curve. ''AAcceptedDeviation'' indicates the
    135        maximum orthogonal distance that is ignored and approximated by a straight line.
    136        ''AIncludeFirstPoint'' indicates if the first point must be included in the array }
    137     function ToPoints(AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF;
    138     function GetBounds: TRectF;
    139   end;
    140 
    141   {** Creates a structure for a cubic Bézier curve }
    142   function BezierCurve(origin, control1, control2, destination: TPointF) : TCubicBezierCurve; overload;
    143 
    144 type
    145   { TQuadraticBezierCurve }
    146   {* Definition of a Bézier curve of order 2. It has one control point }
    147   TQuadraticBezierCurve = object
    148   private
    149     function SimpleComputePoints(AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF;
    150     function ComputeExtremumPositionOutsideSegment: single;
    151   public
    152     {** Starting point (reached) }
    153     p1: TPointF;
    154     {** Control point (not reached by the curve) }
    155     c: TPointF;
    156     {** Ending point (reached) }
    157     p2: TPointF;
    158     {** Computes the point at time ''t'', varying from 0 to 1 }
    159     function ComputePointAt(t: single): TPointF;
    160     {** Split the curve in two such that ''ALeft.p2'' = ''ARight.p1'' }
    161     procedure Split(out ALeft, ARight: TQuadraticBezierCurve);
    162     {** Compute the '''exact''' length of the curve }
    163     function ComputeLength: single;
    164     {** Computes a polygonal approximation of the curve. ''AAcceptedDeviation'' indicates the
    165        maximum orthogonal distance that is ignored and approximated by a straight line.
    166        ''AIncludeFirstPoint'' indicates if the first point must be included in the array }
    167     function ToPoints(AAcceptedDeviation: single = 0.1; AIncludeFirstPoint: boolean = true): ArrayOfTPointF;
    168     function GetBounds: TRectF;
    169   end;
    170 
    171   {** Creates a structure for a quadratic Bézier curve }
    172   function BezierCurve(origin, control, destination: TPointF) : TQuadraticBezierCurve; overload;
    173   {** Creates a structure for a quadratic Bézier curve without curvature }
    174   function BezierCurve(origin, destination: TPointF) : TQuadraticBezierCurve; overload;
     228    ssVertexToSide,
     229    {** The curve is rounded using Bezier curves when the angle is less than or equal to 45° }
     230    ssEasyBezier);
    175231
    176232type
    … …  
    271327      procedure SetStrokeMatrix(const AValue: TAffineMatrix); virtual; abstract;
    272328  public
    273       function ComputePolyline(const APoints: array of TPointF; AWidth: single; AClosedCap: boolean = true): ArrayOfTPointF; virtual; abstract;
    274       function ComputePolyline(const APoints: array of TPointF; AWidth: single; APenColor: TBGRAPixel; AClosedCap: boolean = true): ArrayOfTPointF; virtual; abstract;
     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;
    275331      function ComputePolylineAutoCycle(const APoints: array of TPointF; AWidth: single): ArrayOfTPointF; virtual; abstract;
    276332      function ComputePolygon(const APoints: array of TPointF; AWidth: single): ArrayOfTPointF; virtual; abstract;
    … …  
    325381  {** Computes the intersection of two lines. If they are parallel, returns
    326382      the middle of the segment between the two origins }
    327   function IntersectLine(line1, line2: TLineDef): TPointF;
     383  function IntersectLine(line1, line2: TLineDef): TPointF; overload;
    328384  {** Computes the intersection of two lines. If they are parallel, returns
    329385      the middle of the segment between the two origins. The value ''parallel''
    330386      is set to indicate if the lines were parallel }
    331   function IntersectLine(line1, line2: TLineDef; out parallel: boolean): TPointF;
     387  function IntersectLine(line1, line2: TLineDef; out parallel: boolean): TPointF; overload;
    332388  {** Checks if the polygon formed by the given points is convex. ''IgnoreAlign''
    333389      specifies that if the points are aligned, it should still be considered as convex }
    … …  
    348404    procedure closePath;
    349405    {** Moves to a location, disconnected from previous points }
    350     procedure moveTo(const pt: TPointF);
     406    procedure moveTo(constref pt: TPointF);
    351407    {** Adds a line from the current point }
    352     procedure lineTo(const pt: TPointF);
     408    procedure lineTo(constref pt: TPointF);
    353409    {** Adds a polyline from the current point }
    354410    procedure polylineTo(const pts: array of TPointF);
    355411    {** Adds a quadratic Bézier curve from the current point }
    356     procedure quadraticCurveTo(const cp,pt: TPointF);
     412    procedure quadraticCurveTo(constref cp,pt: TPointF);
    357413    {** Adds a cubic Bézier curve from the current point }
    358     procedure bezierCurveTo(const cp1,cp2,pt: TPointF);
     414    procedure bezierCurveTo(constref cp1,cp2,pt: TPointF);
    359415    {** Adds an arc. If there is a current point, it is connected to the beginning of the arc }
    360     procedure arc(const arcDef: TArcDef);
     416    procedure arc(constref arcDef: TArcDef);
    361417    {** Adds an opened spline. If there is a current point, it is connected to the beginning of the spline }
    362418    procedure openedSpline(const pts: array of TPointF; style: TSplineStyle);
    … …  
    366422    procedure copyTo(dest: IBGRAPath);
    367423    {** Returns the content of the path as an array of points }
    368     function getPoints: ArrayOfTPointF;
     424    function getPoints: ArrayOfTPointF; overload;
    369425    {** Returns the content of the path as an array of points with the transformation specified by ''AMatrix'' }
    370     function getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF;
     426    function getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF; overload;
    371427    {** Returns a cursor to go through the path. The cursor must be freed by calling ''Free''. }
    372428    function getCursor: TBGRACustomPathCursor;
    373429  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;
    374458
    375459  { TBGRACustomPathCursor }
    … …  
    420504  end;
    421505
     506var
     507  BGRAPathFactory: TBGRAPathAny;
     508
    422509const
    423510  {* A value for an empty rectangle }
    … …  
    428515{* Creates a rectangle with the specified ''width'' and ''height'' }
    429516function RectWithSize(left,top,width,height: integer): TRect;
     517
     518{$DEFINE INCLUDE_INTERFACE}
     519{$I bezier.inc}
    430520
    431521type
    … …  
    501591    gtDiamond,
    502592    {** The color changes in a radial way from a given center }
    503     gtRadial);
     593    gtRadial,
     594    {** The color changes according to the angle relative to a given center }
     595    gtAngular);
    504596const
    505597  {** List of string to represent gradient types }
    506598  GradientTypeStr : array[TGradientType] of string
    507   = ('Linear','Reflected','Diamond','Radial');
     599  = ('Linear','Reflected','Diamond','Radial','Angular');
    508600  {** Returns the gradient type represented by the given string }
    509601  function StrToGradientType(str: string): TGradientType;
    … …  
    539631{$UNDEF INCLUDE_IMPLEMENTATION}
    540632
     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
    541966function StrToGradientType(str: string): TGradientType;
    542967var gt: TGradientType;
    … …  
    6671092end;
    6681093
    669 //-------------- Bézier curves definitions ----------------
    670 // See : http://en.wikipedia.org/wiki/B%C3%A9zier_curve
    671 
    672 // Define a Bézier curve with two control points.
    673 function BezierCurve(origin, control1, control2, destination: TPointF): TCubicBezierCurve;
    674 begin
    675   result.p1 := origin;
    676   result.c1 := control1;
    677   result.c2 := control2;
    678   result.p2 := destination;
    679 end;
    680 
    681 // Define a Bézier curve with one control point.
    682 function BezierCurve(origin, control, destination: TPointF
    683   ): TQuadraticBezierCurve;
    684 begin
    685   result.p1 := origin;
    686   result.c := control;
    687   result.p2 := destination;
    688 end;
    689 
    690 //straight line
    691 function BezierCurve(origin, destination: TPointF): TQuadraticBezierCurve;
    692 begin
    693   result.p1 := origin;
    694   result.c := (origin+destination)*0.5;
    695   result.p2 := destination;
     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;
    6961113end;
    6971114
    … …  
    8321249end;
    8331250
     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
    8341270function PointF(x, y: single): TPointF;
    8351271begin
    8361272  Result.x := x;
    8371273  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;
    8381285end;
    8391286
    … …  
    8671314function VectLen(v: TPointF): single;
    8681315begin
    869   result := sqrt(v*v);
     1316  if isEmptyPointF(v) then
     1317    result := EmptySingle
     1318  else
     1319    result := sqrt(v*v);
    8701320end;
    8711321
    … …  
    10691519end;
    10701520
    1071 {------------------ Bezier curves ------------------------}
    1072 
    1073 function ComputeBezierCurvePrecision(pt1, pt2, pt3, pt4: TPointF; AAcceptedDeviation: single = 0.1): integer;
    1074 var
    1075   len: single;
    1076 begin
    1077   len    := sqr(pt1.x - pt2.x) + sqr(pt1.y - pt2.y);
    1078   len    := max(len, sqr(pt3.x - pt2.x) + sqr(pt3.y - pt2.y));
    1079   len    := max(len, sqr(pt3.x - pt4.x) + sqr(pt3.y - pt4.y));
    1080   Result := round(sqrt(sqrt(len)/ AAcceptedDeviation) * 1);
    1081   if Result<=0 then Result:=1;
    1082 end;
    1083 
    1084 { TCubicBezierCurve }
    1085 
    1086 function TCubicBezierCurve.SimpleComputePoints(AAcceptedDeviation: single;
    1087   AIncludeFirstPoint: boolean = true): ArrayOfTPointF;
    1088 var
    1089   t,step: single;
    1090   i,nb: Integer;
    1091 begin
    1092   nb := ComputeBezierCurvePrecision(p1,c1,c2,p2, AAcceptedDeviation/2);
    1093   if nb <= 1 then nb := 2;
    1094   if AIncludeFirstPoint then
    1095   begin
    1096     setlength(result,nb);
    1097     result[0] := p1;
    1098     result[nb-1] := p2;
    1099     step := 1/(nb-1);
    1100     t := 0;
    1101     for i := 1 to nb-2 do
    1102     begin
    1103       t += step;
    1104       result[i] := ComputePointAt(t);
    1105     end;
    1106   end else
    1107   begin
    1108     setlength(result,nb-1);
    1109     result[nb-2] := p2;
    1110     step := 1/(nb-1);
    1111     t := 0;
    1112     for i := 0 to nb-3 do
    1113     begin
    1114       t += step;
    1115       result[i] := ComputePointAt(t);
    1116     end;
    1117   end;
    1118 end;
    1119 
    1120 function TCubicBezierCurve.ComputePointAt(t: single): TPointF;
    1121 var
    1122   f1,f2,f3,f4: single;
    1123 begin
    1124   f1 := (1-t);
    1125   f2 := f1*f1;
    1126   f1 *= f2;
    1127   f2 *= t*3;
    1128   f4 := t*t;
    1129   f3 := f4*(1-t)*3;
    1130   f4 *= t;
    1131 
    1132   result.x := f1*p1.x + f2*c1.x +
    1133               f3*c2.x + f4*p2.x;
    1134   result.y := f1*p1.y + f2*c1.y +
    1135               f3*c2.y + f4*p2.y;
    1136 end;
    1137 
    1138 procedure TCubicBezierCurve.Split(out ALeft, ARight: TCubicBezierCurve);
    1139 var midc: TPointF;
    1140 begin
    1141   ALeft.p1 := p1;
    1142   ALeft.c1 := 0.5*(p1+c1);
    1143   ARight.p2 := p2;
    1144   ARight.c2 := 0.5*(p2+c2);
    1145   midc := 0.5*(c1+c2);
    1146   ALeft.c2 := 0.5*(ALeft.c1+midc);
    1147   ARight.c1 := 0.5*(ARight.c2+midc);
    1148   ALeft.p2 := 0.5*(ALeft.c2+ARight.c1);
    1149   ARight.p1 := ALeft.p2;
    1150 end;
    1151 
    1152 function TCubicBezierCurve.ComputeLength(AAcceptedDeviation: single): single;
    1153 var
    1154   t,step: single;
    1155   i,nb: Integer;
    1156   curCoord,nextCoord: TPointF;
    1157 begin
    1158   nb := ComputeBezierCurvePrecision(p1,c1,c2,p2, AAcceptedDeviation);
    1159   if nb <= 1 then nb := 2;
    1160   result := 0;
    1161   curCoord := p1;
    1162   step := 1/(nb-1);
    1163   t := 0;
    1164   for i := 1 to nb-2 do
    1165   begin
    1166     t += step;
    1167     nextCoord := ComputePointAt(t);
    1168     result += VectLen(nextCoord-curCoord);
    1169     curCoord := nextCoord;
    1170   end;
    1171   result += VectLen(p2-curCoord);
    1172 end;
    1173 
    1174 function TCubicBezierCurve.ToPoints(AAcceptedDeviation: single;
    1175   AIncludeFirstPoint: boolean = true): ArrayOfTPointF;
    1176 begin
    1177   result := SimpleComputePoints(AAcceptedDeviation, AIncludeFirstPoint);
    1178 end;
    1179 
    1180 {//The following function computes by splitting the curve. It is slower than the simple function.
    1181 function TCubicBezierCurve.ToPoints(AAcceptedDeviation: single;
    1182   ARelativeDeviation: boolean): ArrayOfTPointF;
    1183   function ToPointsRec(const ACurve: TCubicBezierCurve): ArrayOfTPointF;
    1184   var simpleLen2: single;
    1185     v: TPointF;
    1186     left,right: TCubicBezierCurve;
    1187     subLeft,subRight: ArrayOfTPointF;
    1188     maxDev,dev1,dev2: single;
    1189     subLeftLen: integer;
    1190 
    1191     procedure ComputeExtremum;
    1192     begin
    1193       raise Exception.Create('Not implemented');
    1194       result := nil;
    1195     end;
    1196 
    1197   begin
    1198     v := ACurve.p2-ACurve.p1;
    1199     simpleLen2 := v*v;
    1200     if simpleLen2 = 0 then
    1201     begin
    1202       if (ACurve.c1.x = ACurve.p1.x) and (ACurve.c1.y = ACurve.p1.y) and
    1203          (ACurve.c2.x = ACurve.p2.x) and (ACurve.c2.y = ACurve.p2.y) then
    1204       begin
    1205         result := nil;
    1206         exit;
    1207       end;
    1208       ACurve.Split(left,right);
    1209     end else
    1210     begin
    1211       ACurve.Split(left,right);
    1212       if not ARelativeDeviation then simpleLen2:= sqrt(simpleLen2);
    1213       maxDev := AAcceptedDeviation*simpleLen2;
    1214       if abs(PointF(v.y,-v.x) * (left.p2-ACurve.p1)) <= maxDev then
    1215       begin
    1216         dev1 := PointF(v.y,-v.x) * (ACurve.c1-ACurve.p1);
    1217         dev2 := PointF(v.y,-v.x) * (ACurve.c2-ACurve.p2);
    1218         if not ((Sign(dev1)<>Sign(dev2)) and ((abs(dev1) > maxDev) or (abs(dev2) > maxDev))) then
    1219         begin
    1220           result := nil;
    1221           if ((ACurve.c1-ACurve.p1)*v < -maxDev) or
    1222              ((ACurve.c1-ACurve.p2)*v > maxDev) or
    1223              ((ACurve.c2-ACurve.p1)*v < -maxDev) or
    1224              ((ACurve.c2-ACurve.p2)*v > maxDev) then
    1225             ComputeExtremum;
    1226           exit;
    1227         end;
    1228       end;
    1229     end;
    1230     subRight := ToPointsRec(right);
    1231     subLeft := ToPointsRec(left);
    1232     subLeftLen := length(subLeft);
    1233 
    1234     //avoid leaving a gap in memory
    1235     result := subLeft;
    1236     subLeft := nil;
    1237     setlength(result, subLeftLen+1+length(subRight));
    1238     result[subLeftLen] := left.p2;
    1239     move(subRight[0], result[subLeftLen+1], length(subRight)*sizeof(TPointF));
    1240   end;
    1241 
    1242 var
    1243   subLen: integer;
    1244 
    1245 begin
    1246   if (c1.x = p1.x) and (c1.y = p1.y) and
    1247      (c1.x = c2.x) and (c1.y = c2.y) and
    1248      (c1.x = p2.x) and (c1.y = p2.y) then
    1249   begin
    1250     setlength(result,1);
    1251     result[0] := c1;
    1252     exit;
    1253   end else
    1254   begin
    1255     result := ToPointsRec(self);
    1256     subLen := length(result);
    1257     setlength(result, length(result)+2);
    1258     move(result[0], result[1], subLen*sizeof(TPointF));
    1259     result[0] := p1;
    1260     result[high(result)] := p2;
    1261   end;
    1262 end;}
    1263 
    1264 function TCubicBezierCurve.GetBounds: TRectF;
    1265 const precision = 1e-5;
    1266 
    1267   procedure Include(pt: TPointF);
    1268   begin
    1269     if pt.x < result.Left then result.Left := pt.x
    1270     else if pt.x > result.Right then result.Right := pt.x;
    1271     if pt.y < result.Top then result.Top := pt.y
    1272     else if pt.y > result.Bottom then result.Bottom := pt.y;
    1273   end;
    1274 
    1275   procedure IncludeT(t: single);
    1276   begin
    1277     if (t > 0) and (t < 1) then
    1278       Include(ComputePointAt(t));
    1279   end;
    1280 
    1281   procedure IncludeABC(a,b,c: single);
    1282   var b2ac, sqrtb2ac: single;
    1283   begin
    1284     if abs(a) < precision then
    1285     begin
    1286       if abs(b) < precision then exit;
    1287       IncludeT(-c/b);
    1288     end else
    1289     begin
    1290       b2ac := sqr(b) - 4 * a * c;
    1291       if b2ac >= 0 then
    1292       begin
    1293         sqrtb2ac := sqrt(b2ac);
    1294         IncludeT((-b + sqrtb2ac) / (2 * a));
    1295         IncludeT((-b - sqrtb2ac) / (2 * a));
    1296       end;
    1297     end;
    1298   end;
    1299 
    1300 var
    1301   va, vb, vc: TPointF;
    1302 
    1303 begin
    1304   result.TopLeft := p1;
    1305   result.BottomRight := p1;
    1306   Include(p2);
    1307 
    1308   vb := 6 * p1 - 12 * c1 + 6 * c2;
    1309   va := -3 * p1 + 9 * c1 - 9 * c2 + 3 * p2;
    1310   vc := 3 * c1 - 3 * p1;
    1311 
    1312   IncludeABC(va.x,vb.x,vc.x);
    1313   IncludeABC(va.y,vb.y,vc.y);
    1314 end;
    1315 
    1316 { TQuadraticBezierCurve }
    1317 
    1318 function TQuadraticBezierCurve.SimpleComputePoints(AAcceptedDeviation: single;
    1319   AIncludeFirstPoint: boolean = true): ArrayOfTPointF;
    1320 var
    1321   t,step: single;
    1322   i,nb: Integer;
    1323 begin
    1324   nb := ComputeBezierCurvePrecision(p1,c,c,p2, AAcceptedDeviation);
    1325   if nb <= 1 then nb := 2;
    1326   if AIncludeFirstPoint then
    1327   begin
    1328     setlength(result,nb);
    1329     result[0] := p1;
    1330     result[nb-1] := p2;
    1331     step := 1/(nb-1);
    1332     t := 0;
    1333     for i := 1 to nb-2 do
    1334     begin
    1335       t += step;
    1336       result[i] := ComputePointAt(t);
    1337     end;
    1338   end else
    1339   begin
    1340     setlength(result,nb-1);
    1341     result[nb-2] := p2;
    1342     step := 1/(nb-1);
    1343     t := 0;
    1344     for i := 0 to nb-3 do
    1345     begin
    1346       t += step;
    1347       result[i] := ComputePointAt(t);
    1348     end;
    1349   end;
    1350 end;
    1351 
    1352 function TQuadraticBezierCurve.ComputeExtremumPositionOutsideSegment: single;
    1353 var a,b: single;
    1354   v: TPointF;
    1355 begin
    1356   v := self.p2-self.p1;
    1357   a := (self.p1-2*self.c+self.p2)*v;
    1358   if a = 0 then //no solution
    1359   begin
    1360     result := -1;
    1361     exit;
    1362   end;
    1363   b := (self.c-self.p1)*v;
    1364   result := -b/a;
    1365 end;
    1366 
    1367 function TQuadraticBezierCurve.ComputePointAt(t: single): TPointF;
    1368 var
    1369   rev_t,f2,t2: single;
    1370 begin
    1371   rev_t := (1-t);
    1372   f2 := rev_t*t*2;
    1373   rev_t *= rev_t;
    1374   t2 := t*t;
    1375   result.x := rev_t*p1.x + f2*c.x + t2*p2.x;
    1376   result.y := rev_t*p1.y + f2*c.y + t2*p2.y;
    1377 end;
    1378 
    1379 procedure TQuadraticBezierCurve.Split(out ALeft, ARight: TQuadraticBezierCurve);
    1380 begin
    1381   ALeft.p1 := p1;
    1382   ALeft.c := 0.5*(p1+c);
    1383   ARight.p2 := p2;
    1384   ARight.c := 0.5*(p2+c);
    1385   ALeft.p2 := 0.5*(ALeft.c+ARight.c);
    1386   ARight.p1 := ALeft.p2;
    1387 end;
    1388 
    1389 function TQuadraticBezierCurve.ComputeLength: single;
    1390 var a,b: TPointF;
    1391   A_,AB_,B_,Sabc,A_2,A_32,B_2,BA,
    1392   divisor: single;
    1393   extremumPos: single;
    1394   extremum: TPointF;
    1395 begin
    1396   a := p1 - 2*c + p2;
    1397   b := 2*(c - p1);
    1398   A_ := 4*(a*a);
    1399   B_ := b*b;
    1400   if (A_ = 0) or (B_ = 0) then
    1401   begin
    1402     result := VectLen(p2-p1);
    1403     exit;
    1404   end;
    1405   AB_ := 4*(a*b);
    1406 
    1407   A_2 := sqrt(A_);
    1408   B_2 := 2*sqrt(B_);
    1409   BA := AB_/A_2;
    1410   divisor := BA+B_2;
    1411   if divisor <= 0 then
    1412   begin
    1413     extremumPos:= ComputeExtremumPositionOutsideSegment;
    1414     if (extremumPos <= 0) or (extremumPos >= 1) then
    1415       result := VectLen(p2-p1)
    1416     else
    1417     begin
    1418       extremum := ComputePointAt(extremumPos);
    1419       result := VectLen(extremum-p1)+VectLen(p2-extremum);
    1420     end;
    1421     exit;
    1422   end;
    1423 
    1424   Sabc := 2*sqrt(A_+AB_+B_);
    1425   A_32 := 2*A_*A_2;
    1426   result := ( A_32*Sabc +
    1427               A_2*AB_*(Sabc-B_2) +
    1428               (4*B_*A_-AB_*AB_)*ln( (2*A_2+BA+Sabc)/divisor )
    1429             )/(4*A_32);
    1430 end;
    1431 
    1432 function TQuadraticBezierCurve.ToPoints(AAcceptedDeviation: single;
    1433   AIncludeFirstPoint: boolean = true): ArrayOfTPointF;
    1434 begin
    1435   result := SimpleComputePoints(AAcceptedDeviation, AIncludeFirstPoint);
    1436 end;
    1437 
    1438 function TQuadraticBezierCurve.GetBounds: TRectF;
    1439 const precision = 1e-5;
    1440 
    1441   procedure Include(pt: TPointF);
    1442   begin
    1443     if pt.x < result.Left then result.Left := pt.x
    1444     else if pt.x > result.Right then result.Right := pt.x;
    1445     if pt.y < result.Top then result.Top := pt.y
    1446     else if pt.y > result.Bottom then result.Bottom := pt.y;
    1447   end;
    1448 
    1449   procedure IncludeT(t: single);
    1450   begin
    1451     if (t > 0) and (t < 1) then
    1452       Include(ComputePointAt(t));
    1453   end;
    1454 
    1455   procedure IncludeABC(a,b,c: single);
    1456   var denom: single;
    1457   begin
    1458     denom := a-2*b+c;
    1459     if abs(denom) < precision then exit;
    1460     IncludeT((a-b)/denom);
    1461   end;
    1462 
    1463 begin
    1464   result.TopLeft := p1;
    1465   result.BottomRight := p1;
    1466   Include(p2);
    1467 
    1468   IncludeABC(p1.x,c.x,p2.x);
    1469   IncludeABC(p1.y,c.y,p2.y);
    1470 end;
    1471 
    1472 {//The following function computes by splitting the curve. It is slower than the simple function
    1473 function TQuadraticBezierCurve.ToPoints(AAcceptedDeviation: single; ARelativeDeviation: boolean): ArrayOfTPointF;
    1474 
    1475   function ToPointsRec(const ACurve: TQuadraticBezierCurve): ArrayOfTPointF;
    1476   var simpleLen2: single;
    1477     v: TPointF;
    1478     left,right: TQuadraticBezierCurve;
    1479     subLeft,subRight: ArrayOfTPointF;
    1480     subLeftLen: Integer;
    1481 
    1482     procedure ComputeExtremum;
    1483     var
    1484       t: single;
    1485     begin
    1486       t := ACurve.ComputeExtremumPositionOutsideSegment;
    1487       if (t <= 0) or (t >= 1) then
    1488         result := nil
    1489       else
    1490       begin
    1491         setlength(result,1);
    1492         result[0] := ACurve.ComputePointAt(t);
    1493       end;
    1494     end;
    1495 
    1496   begin
    1497     v := ACurve.p2-ACurve.p1;
    1498     simpleLen2 := v*v;
    1499     if simpleLen2 = 0 then
    1500     begin
    1501       if (ACurve.c.x = ACurve.p1.x) and (ACurve.c.y = ACurve.p1.y) then
    1502       begin
    1503         result := nil;
    1504         exit;
    1505       end;
    1506       ACurve.Split(left,right);
    1507     end else
    1508     begin
    1509       ACurve.Split(left,right);
    1510       if not ARelativeDeviation then simpleLen2:= sqrt(simpleLen2);
    1511       if abs(PointF(v.y,-v.x) * (left.p2-ACurve.p1))
    1512           <= AAcceptedDeviation*simpleLen2 then
    1513       begin
    1514         result := nil;
    1515         if ((ACurve.c-ACurve.p1)*v < -AAcceptedDeviation*simpleLen2) or
    1516            ((ACurve.c-ACurve.p2)*v > AAcceptedDeviation*simpleLen2) then
    1517           ComputeExtremum;
    1518         exit;
    1519       end;
    1520     end;
    1521     subRight := ToPointsRec(right);
    1522     subLeft := ToPointsRec(left);
    1523     subLeftLen := length(subLeft);
    1524 
    1525     //avoid leaving a gap in memory
    1526     result := subLeft;
    1527     subLeft := nil;
    1528     setlength(result, subLeftLen+1+length(subRight));
    1529     result[subLeftLen] := left.p2;
    1530     move(subRight[0], result[subLeftLen+1], length(subRight)*sizeof(TPointF));
    1531   end;
    1532 
    1533 var
    1534   subLen: integer;
    1535 
    1536 begin
    1537   if (c.x = p1.x) and (c.y = p1.y) and
    1538      (c.x = p2.x) and (c.y = p2.y) then
    1539   begin
    1540     setlength(result,1);
    1541     result[0] := c;
    1542     exit;
    1543   end else
    1544   begin
    1545     result := ToPointsRec(self);
    1546     subLen := length(result);
    1547     setlength(result, length(result)+2);
    1548     move(result[0], result[1], subLen*sizeof(TPointF));
    1549     result[0] := p1;
    1550     result[high(result)] := p2;
    1551   end;
    1552 end;}
     1521{$DEFINE INCLUDE_IMPLEMENTATION}
     1522{$I bezier.inc}
     1523
    15531524{$ENDIF}
Note: See TracChangeset for help on using the changeset viewer.