Ignore:
Timestamp:
Dec 22, 2016, 8:49:19 PM (7 years ago)
Author:
chronos
Message:
  • Modified: Updated BGRABitmap package.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest/Packages/bgrabitmap/bgrapath.pas

    r472 r494  
    44
    55interface
     6
     7//todo: tangent interpolation
    68
    79{ There are different conventions for angles.
    … …  
    3941
    4042type
    41   TBGRAPathElementType = (peNone, peMoveTo, peLineTo, peCloseSubPath, peQuadraticBezierTo, peCubicBezierTo, peArc);
    42   PBGRAPathElementType = ^TBGRAPathElementType;
     43  TBGRAPathElementType = (peNone, peMoveTo, peLineTo, peCloseSubPath,
     44    peQuadraticBezierTo, peCubicBezierTo, peArc, peOpenedSpline,
     45    peClosedSpline);
     46
     47  TBGRAPathDrawProc = procedure(const APoints: array of TPointF; AClosed: boolean; AData: Pointer) of object;
     48  TBGRAPathFillProc = procedure(const APoints: array of TPointF; AData: pointer) of object;
     49
     50  TBGRAPath = class;
     51
     52  { TBGRAPathCursor }
     53
     54  TBGRAPathCursor = class(TBGRACustomPathCursor)
     55  protected
     56    FPath: TBGRAPath;
     57    FDataPos: IntPtr;
     58    FAcceptedDeviation: single;
     59    FPathLength: single;
     60    FPathLengthComputed: boolean;
     61    FBounds: TRectF;
     62    FBoundsComputed: boolean;
     63    FArcPos: Single;
     64
     65    FStartCoordinate: TPointF;
     66    FEndCoordinate: TPointF;
     67    FLoopClosedShapes,FLoopPath: boolean;
     68
     69    FCurrentElementType: TBGRAPathElementType;
     70    FCurrentElement: Pointer;
     71    FCurrentElementArcPos,
     72    FCurrentElementArcPosScale: single;
     73    FCurrentElementStartCoord,
     74    FCurrentElementEndCoord: TPointF;
     75    FCurrentElementLength: single;
     76    FCurrentElementPoints: array of TPointF;
     77    FCurrentSegment: NativeInt;
     78    FCurrentSegmentPos: single;
     79    function GoToNextElement(ACanJump: boolean): boolean;
     80    function GoToPreviousElement(ACanJump: boolean): boolean;
     81    procedure MoveToEndOfElement;
     82    procedure MoveForwardInElement(ADistance: single);
     83    procedure MoveBackwardInElement(ADistance: single);
     84    function NeedPolygonalApprox: boolean;
     85    procedure OnPathFree; virtual;
     86
     87    function GetLoopClosedShapes: boolean; override;
     88    function GetLoopPath: boolean; override;
     89    function GetStartCoordinate: TPointF; override;
     90    procedure SetLoopClosedShapes(AValue: boolean); override;
     91    procedure SetLoopPath(AValue: boolean); override;
     92
     93    function GetArcPos: single; override;
     94    function GetCurrentTangent: TPointF; override;
     95    procedure SetArcPos(AValue: single); override;
     96    function GetBounds: TRectF; override;
     97    function GetPathLength: single; override;
     98    procedure PrepareCurrentElement; virtual;
     99    function GetCurrentCoord: TPointF; override;
     100    function GetPath: TBGRAPath; virtual;
     101  public
     102    constructor Create(APath: TBGRAPath; AAcceptedDeviation: single = 0.1);
     103    function MoveForward(ADistance: single; ACanJump: boolean = true): single; override;
     104    function MoveBackward(ADistance: single; ACanJump: boolean = true): single; override;
     105    destructor Destroy; override;
     106    property CurrentCoordinate: TPointF read GetCurrentCoord;
     107    property CurrentTangent: TPointF read GetCurrentTangent;
     108    property Position: single read GetArcPos write SetArcPos;
     109    property PathLength: single read GetPathLength;
     110    property Path: TBGRAPath read GetPath;
     111    property Bounds: TRectF read GetBounds;
     112    property StartCoordinate: TPointF read GetStartCoordinate;
     113    property LoopClosedShapes: boolean read GetLoopClosedShapes write SetLoopClosedShapes;
     114    property LoopPath: boolean read GetLoopPath write SetLoopPath;
     115    property AcceptedDeviation: single read FAcceptedDeviation;
     116  end;
    43117
    44118  { TBGRAPath }
    45119
    46120  TBGRAPath = class(IBGRAPath)
    47   private
    48     function GetSvgString: string;
    49     procedure SetSvgString(const AValue: string);
    50121  protected
    51     FData: pbyte;
    52     FDataSize: integer;
    53     FDataPos: integer;
    54     FLastElementType: TBGRAPathElementType;
    55     FLastCoord,
    56     FStartCoord: TPointF;
    57     FExpectedControlPoint: TPointF;
     122    FData: PByte;
     123    FDataCapacity: PtrInt;
     124    FDataPos: PtrInt;
     125    FLastSubPathElementType, FLastStoredElementType: TBGRAPathElementType;
     126    FLastMoveToDataPos: PtrInt;
     127    FLastCoord,FLastTransformedCoord,
     128    FSubPathStartCoord, FSubPathTransformedStartCoord: TPointF;
     129    FExpectedTransformedControlPoint: TPointF;
    58130    FMatrix: TAffineMatrix; //this matrix must have a base of vectors
    59131                            //orthogonal, of same length and with positive
    60132                            //orientation in order to preserve arcs
    61133    FScale,FAngleRadCW: single;
     134    FCursors: array of TBGRAPathCursor;
     135    FInternalDrawOffset: TPointF;
     136    procedure OnModify;
     137    procedure OnMatrixChange;
    62138    procedure NeedSpace(count: integer);
    63     procedure StoreCoord(const pt: TPointF);
    64     function ReadCoord: TPointF;
    65     procedure StoreElementType(value: TBGRAPathElementType);
    66     function ReadElementType: TBGRAPathElementType;
    67     function ReadArcDef: TArcDef;
    68     procedure RewindFloat;
     139    function AllocateElement(AElementType: TBGRAPathElementType;
     140  AExtraBytes: PtrInt = 0): Pointer;
    69141    procedure Init;
     142    procedure DoClear;
     143    function CheckElementType(AElementType: TBGRAPathElementType): boolean;
     144    function GoToNextElement(var APos: PtrInt): boolean;
     145    function GoToPreviousElement(var APos: PtrInt): boolean;
     146    function PeekNextElement(APos: PtrInt): TBGRAPathElementType;
     147    function GetElementStartCoord(APos: PtrInt): TPointF;
     148    function GetElementEndCoord(APos: PtrInt): TPointF;
     149    function GetElementLength(APos: PtrInt; AAcceptedDeviation: single): Single;
     150    procedure GetElementAt(APos: PtrInt;
     151      out AElementType: TBGRAPathElementType; out AElement: pointer);
     152    function GetSvgString: string; virtual;
     153    procedure SetSvgString(const AValue: string); virtual;
     154    procedure RegisterCursor(ACursor: TBGRAPathCursor);
     155    procedure UnregisterCursor(ACursor: TBGRAPathCursor);
     156    function SetLastCoord(ACoord: TPointF): TPointF; inline;
     157    procedure ClearLastCoord;
     158    procedure BezierCurveFromTransformed(tcp1, cp2, pt:TPointF);
     159    procedure QuadraticCurveFromTransformed(tcp, pt: TPointF);
     160    function LastCoordDefined: boolean; inline;
     161    function GetPolygonalApprox(APos: IntPtr; AAcceptedDeviation: single; AIncludeFirstPoint: boolean): ArrayOfTPointF;
     162    function getPoints: ArrayOfTPointF;
     163    function getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF;
     164    function getCursor: TBGRACustomPathCursor;
     165    procedure InternalDraw(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer);
     166    procedure BitmapDrawSubPathProc(const APoints: array of TPointF; AClosed: boolean; AData: pointer);
     167    function CorrectAcceptedDeviation(AAcceptedDeviation: single; const AMatrix: TAffineMatrix): single;
    70168  public
    71169    constructor Create; overload;
    72170    constructor Create(ASvgString: string); overload;
     171    constructor Create(const APoints: ArrayOfTPointF); overload;
     172    constructor Create(APath: IBGRAPath); overload;
    73173    destructor Destroy; override;
    74174    procedure beginPath;
     175    procedure beginSubPath;
    75176    procedure closePath;
    76177    procedure translate(x,y: single);
    … …  
    85186    procedure moveTo(const pt: TPointF); overload;
    86187    procedure lineTo(const pt: TPointF); overload;
     188    procedure polyline(const pts: array of TPointF);
    87189    procedure polylineTo(const pts: array of TPointF);
     190    procedure polygon(const pts: array of TPointF);
    88191    procedure quadraticCurveTo(cpx,cpy,x,y: single); overload;
    89192    procedure quadraticCurveTo(const cp,pt: TPointF); overload;
    90193    procedure quadraticCurve(const curve: TQuadraticBezierCurve); overload;
     194    procedure quadraticCurve(p1,cp,p2: TPointF); overload;
    91195    procedure smoothQuadraticCurveTo(x,y: single); overload;
    92196    procedure smoothQuadraticCurveTo(const pt: TPointF); overload;
    … …  
    94198    procedure bezierCurveTo(const cp1,cp2,pt: TPointF); overload;
    95199    procedure bezierCurve(const curve: TCubicBezierCurve); overload;
     200    procedure bezierCurve(p1,cp1,cp2,p2: TPointF); overload;
    96201    procedure smoothBezierCurveTo(cp2x,cp2y,x,y: single); overload;
    97202    procedure smoothBezierCurveTo(const cp2,pt: TPointF); overload;
    … …  
    105210    procedure arcTo(const p1,p2: TPointF; radius: single); overload;
    106211    procedure arc(const arcDef: TArcDef); overload;
    107     procedure arc(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single); overload;
     212    procedure arc(cx, cy, rx,ry: single; xAngleRadCW, startAngleRadCW, endAngleRadCW: single); overload;
    108213    procedure arc(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean); overload;
    109214    procedure arcTo(rx,ry, xAngleRadCW: single; largeArc, anticlockwise: boolean; x,y:single);
    … …  
    111216    procedure addPath(const AValue: string); overload;
    112217    procedure addPath(source: IBGRAPath); overload;
     218    procedure openedSpline(const pts: array of TPointF; style: TSplineStyle);
     219    procedure closedSpline(const pts: array of TPointF; style: TSplineStyle);
    113220    property SvgString: string read GetSvgString write SetSvgString;
     221    function ComputeLength(AAcceptedDeviation: single = 0.1): single;
     222    function ToPoints(AAcceptedDeviation: single = 0.1): ArrayOfTPointF; overload;
     223    function ToPoints(AMatrix: TAffineMatrix; AAcceptedDeviation: single = 0.1): ArrayOfTPointF; overload;
     224    function IsEmpty: boolean;
     225    function GetBounds(AAcceptedDeviation: single = 0.1): TRectF;
     226    procedure SetPoints(const APoints: ArrayOfTPointF);
     227    procedure stroke(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single = 0.1);
     228    procedure stroke(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single = 0.1);
     229    procedure stroke(ABitmap: TBGRACustomBitmap; x,y: single; AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single = 0.1);
     230    procedure stroke(ABitmap: TBGRACustomBitmap; x,y: single; ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single = 0.1);
     231    procedure stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single = 0.1);
     232    procedure stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single = 0.1);
     233    procedure stroke(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AAcceptedDeviation: single = 0.1; AData: pointer = nil);
     234    procedure fill(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel; AAcceptedDeviation: single = 0.1);
     235    procedure fill(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner; AAcceptedDeviation: single = 0.1);
     236    procedure fill(ABitmap: TBGRACustomBitmap; x,y: single; AColor: TBGRAPixel; AAcceptedDeviation: single = 0.1);
     237    procedure fill(ABitmap: TBGRACustomBitmap; x,y: single; ATexture: IBGRAScanner; AAcceptedDeviation: single = 0.1);
     238    procedure fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; AColor: TBGRAPixel; AAcceptedDeviation: single = 0.1);
     239    procedure fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AAcceptedDeviation: single = 0.1);
     240    procedure fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; AAcceptedDeviation: single = 0.1; AData: pointer = nil);
     241    function CreateCursor(AAcceptedDeviation: single = 0.1): TBGRAPathCursor;
     242    procedure Fit(ARect: TRectF; AAcceptedDeviation: single = 0.1);
     243    procedure FitInto(ADest: TBGRAPath; ARect: TRectF; AAcceptedDeviation: single = 0.1);
    114244  protected
    115245    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};
    … …  
    121251
    122252function SplineVertexToSide(y0, y1, y2, y3: single; t: single): single;
    123 function ComputeBezierCurve(const curve: TCubicBezierCurve): ArrayOfTPointF; overload;
    124 function ComputeBezierCurve(const curve: TQuadraticBezierCurve): ArrayOfTPointF; overload;
    125 function ComputeBezierSpline(const spline: array of TCubicBezierCurve): ArrayOfTPointF; overload;
    126 function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve): ArrayOfTPointF; overload;
    127 function ComputeClosedSpline(const points: array of TPointF; Style: TSplineStyle): ArrayOfTPointF;
    128 function ComputeOpenedSpline(const points: array of TPointF; Style: TSplineStyle; EndCoeff: single = 0.25): ArrayOfTPointF;
     253function ComputeBezierCurve(const curve: TCubicBezierCurve; AAcceptedDeviation: single = 0.1): ArrayOfTPointF; overload;
     254function ComputeBezierCurve(const curve: TQuadraticBezierCurve; AAcceptedDeviation: single = 0.1): ArrayOfTPointF; overload;
     255function ComputeBezierSpline(const spline: array of TCubicBezierCurve; AAcceptedDeviation: single = 0.1): ArrayOfTPointF; overload;
     256function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve; AAcceptedDeviation: single = 0.1): ArrayOfTPointF; overload;
     257function ComputeClosedSpline(const points: array of TPointF; Style: TSplineStyle; AAcceptedDeviation: single = 0.1): ArrayOfTPointF;
     258function ComputeOpenedSpline(const points: array of TPointF; Style: TSplineStyle; EndCoeff: single = 0.25; AAcceptedDeviation: single = 0.1): ArrayOfTPointF;
     259function ClosedSplineStartPoint(const points: array of TPointF; Style: TSplineStyle): TPointF;
    129260
    130261{ Compute points to draw an antialiased ellipse }
    … …  
    147278uses Math, BGRAResample, SysUtils;
    148279
     280type
     281  TStrokeData = record
     282    Bitmap: TBGRACustomBitmap;
     283    Texture: IBGRAScanner;
     284    Color: TBGRAPixel;
     285    Width: Single;
     286  end;
     287
     288  PPathElementHeader = ^TPathElementHeader;
     289  TPathElementHeader = record
     290    ElementType: TBGRAPathElementType;
     291    PreviousElementType: TBGRAPathElementType;
     292  end;
     293  PMoveToElement = ^TMoveToElement;
     294  TMoveToElement = record
     295    StartCoordinate: TPointF;
     296    LoopDataPos: PtrInt; //if the path is closed
     297  end;
     298  PClosePathElement = ^TClosePathElement;
     299  TClosePathElement = type TMoveToElement;
     300  PQuadraticBezierToElement = ^TQuadraticBezierToElement;
     301  TQuadraticBezierToElement = record
     302    ControlPoint, Destination: TPointF;
     303  end;
     304  PCubicBezierToElement = ^TCubicBezierToElement;
     305  TCubicBezierToElement = record
     306    ControlPoint1, ControlPoint2, Destination: TPointF;
     307  end;
     308  PArcElement = ^TArcElement;
     309  TArcElement = TArcDef;
     310
     311  PSplineElement = ^TSplineElement;
     312  TSplineElement = record
     313    SplineStyle: TSplineStyle;
     314    NbControlPoints: integer;
     315  end;
     316
     317const
     318  PathElementSize : array[TBGRAPathElementType] of PtrInt =
     319  (0, Sizeof(TMoveToElement), Sizeof(TClosePathElement), sizeof(TPointF),
     320   sizeof(TQuadraticBezierToElement), sizeof(TCubicBezierToElement),
     321   sizeof(TArcElement), sizeof(TSplineElement)+sizeof(integer),
     322   sizeof(TSplineElement)+sizeof(integer));
     323
    149324function SplineVertexToSide(y0, y1, y2, y3: single; t: single): single;
    150325var
    … …  
    160335end;
    161336
    162 function ComputeCurvePrecision(pt1, pt2, pt3, pt4: TPointF): integer;
     337function ComputeCurvePartPrecision(pt1, pt2, pt3, pt4: TPointF; AAcceptedDeviation: single = 0.1): integer;
    163338var
    164339  len: single;
    … …  
    167342  len    := max(len, sqr(pt3.x - pt2.x) + sqr(pt3.y - pt2.y));
    168343  len    := max(len, sqr(pt3.x - pt4.x) + sqr(pt3.y - pt4.y));
    169   Result := round(sqrt(sqrt(len)) * 2);
     344  Result := round(sqrt(sqrt(len)/AAcceptedDeviation) * 0.9);
    170345  if Result<=0 then Result:=1;
    171346end;
    172347
    173 function ComputeBezierCurve(const curve: TCubicBezierCurve): ArrayOfTPointF; overload;
    174 var
    175   t,f1,f2,f3,f4: single;
    176   i,nb: Integer;
    177 begin
    178   nb := ComputeCurvePrecision(curve.p1,curve.c1,curve.c2,curve.p2);
    179   if nb <= 1 then nb := 2;
    180   setlength(result,nb);
    181   result[0] := curve.p1;
    182   result[nb-1] := curve.p2;
    183   for i := 1 to nb-2 do
    184   begin
    185     t := i/(nb-1);
    186     f1 := (1-t);
    187     f2 := f1*f1;
    188     f1 *= f2;
    189     f2 *= t*3;
    190     f4 := t*t;
    191     f3 := f4*(1-t)*3;
    192     f4 *= t;
    193 
    194     result[i] := PointF(f1*curve.p1.x + f2*curve.c1.x +
    195                   f3*curve.c2.x + f4*curve.p2.x,
    196                   f1*curve.p1.y + f2*curve.c1.y +
    197                   f3*curve.c2.y + f4*curve.p2.y);
    198   end;
    199 end;
    200 
    201 function ComputeBezierCurve(const curve: TQuadraticBezierCurve): ArrayOfTPointF; overload;
    202 var
    203   t,f1,f2,f3: single;
    204   i,nb: Integer;
    205 begin
    206   nb := ComputeCurvePrecision(curve.p1,curve.c,curve.c,curve.p2);
    207   if nb <= 1 then nb := 2;
    208   setlength(result,nb);
    209   result[0] := curve.p1;
    210   result[nb-1] := curve.p2;
    211   for i := 1 to nb-2 do
    212   begin
    213     t := i/(nb-1);
    214     f1 := (1-t);
    215     f3 := t;
    216     f2 := f1*f3*2;
    217     f1 *= f1;
    218     f3 *= f3;
    219     result[i] := PointF(f1*curve.p1.x + f2*curve.c.x + f3*curve.p2.x,
    220                   f1*curve.p1.y + f2*curve.c.y + f3*curve.p2.y);
    221   end;
    222 end;
    223 
    224 function ComputeBezierSpline(const spline: array of TCubicBezierCurve): ArrayOfTPointF;
     348function ComputeBezierCurve(const curve: TCubicBezierCurve; AAcceptedDeviation: single = 0.1): ArrayOfTPointF; overload;
     349begin
     350  result := curve.ToPoints(AAcceptedDeviation);
     351end;
     352
     353function ComputeBezierCurve(const curve: TQuadraticBezierCurve; AAcceptedDeviation: single = 0.1): ArrayOfTPointF; overload;
     354begin
     355  result := curve.ToPoints(AAcceptedDeviation);
     356end;
     357
     358function ComputeBezierSpline(const spline: array of TCubicBezierCurve; AAcceptedDeviation: single = 0.1): ArrayOfTPointF;
    225359var
    226360  curves: array of array of TPointF;
    … …  
    250384  setlength(curves, length(spline));
    251385  for i := 0 to high(spline) do
    252     curves[i] := ComputeBezierCurve(spline[i]);
     386    curves[i] := ComputeBezierCurve(spline[i],AAcceptedDeviation);
    253387  nb := length(curves[0]);
    254388  lastPt := curves[0][high(curves[0])];
    … …  
    271405end;
    272406
    273 function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve
    274   ): ArrayOfTPointF;
     407function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve;
     408  AAcceptedDeviation: single = 0.1): ArrayOfTPointF;
    275409var
    276410  curves: array of array of TPointF;
    … …  
    300434  setlength(curves, length(spline));
    301435  for i := 0 to high(spline) do
    302     curves[i] := ComputeBezierCurve(spline[i]);
     436    curves[i] := ComputeBezierCurve(spline[i],AAcceptedDeviation);
    303437  nb := length(curves[0]);
    304438  lastPt := curves[0][high(curves[0])];
    … …  
    321455end;
    322456
    323 function ComputeClosedSpline(const points: array of TPointF; Style: TSplineStyle): ArrayOfTPointF;
     457function ComputeClosedSpline(const points: array of TPointF; Style: TSplineStyle; AAcceptedDeviation: single = 0.1): ArrayOfTPointF;
    324458var
    325459  i, j, nb, idx, pre: integer;
    … …  
    344478    ptNext  := points[(i + 1) mod length(points)];
    345479    ptNext2 := points[(i + 2) mod length(points)];
    346     nb      += ComputeCurvePrecision(ptPrev2, ptPrev, ptNext, ptNext2);
     480    nb      += ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation);
    347481  end;
    348482
    349483  kernel := CreateInterpolator(style);
    350484  setlength(Result, nb);
     485  idx := 0;
    351486  for i := 0 to high(points) do
    352487  begin
    … …  
    355490    ptNext  := points[(i + 1) mod length(points)];
    356491    ptNext2 := points[(i + 2) mod length(points)];
    357     pre     := ComputeCurvePrecision(ptPrev2, ptPrev, ptNext, ptNext2);
     492    pre     := ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation);
    358493    if i=0 then
    359     begin
    360       j := 0;
    361       idx := 0;
    362     end else j := 1;
     494      j := 0
     495    else
     496      j := 1;
    363497    while j <= pre do
    364498    begin
    … …  
    373507end;
    374508
    375 function ComputeOpenedSpline(const points: array of TPointF; Style: TSplineStyle; EndCoeff: single): ArrayOfTPointF;
     509function ComputeOpenedSpline(const points: array of TPointF; Style: TSplineStyle; EndCoeff: single; AAcceptedDeviation: single = 0.1): ArrayOfTPointF;
    376510var
    377511  i, j, nb, idx, pre: integer;
    … …  
    403537    else
    404538      ptNext2 := points[i + 2];
    405     nb      += ComputeCurvePrecision(ptPrev2, ptPrev, ptNext, ptNext2);
     539    nb      += ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation);
    406540  end;
    407541
    … …  
    430564    else
    431565      ptNext2 := points[i + 2];
    432     pre     := ComputeCurvePrecision(ptPrev2, ptPrev, ptNext, ptNext2);
     566    pre     := ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation);
    433567    if i=0 then
    434568    begin
    … …  
    447581  if Style in[ssInsideWithEnds,ssCrossingWithEnds] then
    448582    result[idx] := points[high(points)];
     583end;
     584
     585function ClosedSplineStartPoint(const points: array of TPointF;
     586  Style: TSplineStyle): TPointF;
     587var
     588  kernel: TWideKernelFilter;
     589  ptPrev2: TPointF;
     590  ptPrev: TPointF;
     591  ptNext: TPointF;
     592  ptNext2: TPointF;
     593begin
     594  if length(points) = 0 then
     595    result := EmptyPointF
     596  else
     597  if length(points)<=2 then
     598    result := points[0]
     599  else
     600  begin
     601    kernel := CreateInterpolator(style);
     602    ptPrev2 := points[high(points)];
     603    ptPrev  := points[0];
     604    ptNext  := points[1];
     605    ptNext2 := points[2];
     606    result := ptPrev2*kernel.Interpolation(1) + ptPrev*kernel.Interpolation(0) +
     607              ptNext*kernel.Interpolation(-1)  + ptNext2*kernel.Interpolation(-2);
     608    kernel.free;
     609  end;
    449610end;
    450611
    … …  
    707868end;
    708869
     870{ TBGRAPathCursor }
     871
     872function TBGRAPathCursor.GetCurrentCoord: TPointF;
     873begin
     874  case FCurrentElementType of
     875    peNone: result := EmptyPointF;
     876    peMoveTo,peLineTo,peCloseSubPath:
     877      if FCurrentElementLength <= 0 then
     878        result := FCurrentElementStartCoord
     879      else
     880        result := FCurrentElementStartCoord + (FCurrentElementEndCoord-FCurrentElementStartCoord)*(FCurrentElementArcPos/FCurrentElementLength);
     881    peCubicBezierTo,peQuadraticBezierTo,peArc,peOpenedSpline,peClosedSpline:
     882      begin
     883        NeedPolygonalApprox;
     884        if FCurrentSegment >= high(FCurrentElementPoints) then
     885          result := FCurrentElementEndCoord
     886        else
     887          result := FCurrentElementPoints[FCurrentSegment]+
     888          (FCurrentElementPoints[FCurrentSegment+1]-
     889           FCurrentElementPoints[FCurrentSegment])*FCurrentSegmentPos;
     890      end;
     891    else
     892      raise Exception.Create('Unknown element type');
     893  end;
     894end;
     895
     896function TBGRAPathCursor.GetPath: TBGRAPath;
     897begin
     898  if not Assigned(FPath) then
     899    raise exception.Create('Path does not exist');
     900  result := FPath;
     901end;
     902
     903procedure TBGRAPathCursor.MoveToEndOfElement;
     904begin
     905  FCurrentElementArcPos := FCurrentElementLength;
     906  if not NeedPolygonalApprox then exit;
     907  if length(FCurrentElementPoints) > 1 then
     908  begin
     909    FCurrentSegment := high(FCurrentElementPoints)-1;
     910    FCurrentSegmentPos := 1;
     911  end else
     912  begin
     913    FCurrentSegment := high(FCurrentElementPoints);
     914    FCurrentSegmentPos := 0;
     915  end;
     916end;
     917
     918procedure TBGRAPathCursor.MoveForwardInElement(ADistance: single);
     919var segLen,rightSpace,remaining: single;
     920begin
     921  if not NeedPolygonalApprox then exit;
     922  ADistance *= FCurrentElementArcPosScale;
     923  remaining := ADistance;
     924  while remaining > 0 do
     925  begin
     926    if FCurrentSegment < high(FCurrentElementPoints) then
     927      segLen := VectLen(FCurrentElementPoints[FCurrentSegment+1]-FCurrentElementPoints[FCurrentSegment])
     928    else
     929      segLen := 0;
     930    rightSpace := segLen*(1-FCurrentSegmentPos);
     931    if (segLen > 0) and (remaining <= rightSpace) then
     932    begin
     933      FCurrentSegmentPos += remaining/segLen;
     934      exit;
     935    end else
     936    begin
     937      remaining -= rightSpace;
     938      if FCurrentSegment < high(FCurrentElementPoints)-1 then
     939      begin
     940        inc(FCurrentSegment);
     941        FCurrentSegmentPos := 0;
     942      end else
     943      begin
     944        FCurrentSegmentPos := 1;
     945        exit;
     946      end;
     947    end;
     948  end;
     949end;
     950
     951procedure TBGRAPathCursor.MoveBackwardInElement(ADistance: single);
     952var
     953  segLen,leftSpace,remaining: Single;
     954begin
     955  if not NeedPolygonalApprox then exit;
     956  ADistance *= FCurrentElementArcPosScale;
     957  remaining := ADistance;
     958  while remaining > 0 do
     959  begin
     960    if FCurrentSegment < high(FCurrentElementPoints) then
     961      segLen := VectLen(FCurrentElementPoints[FCurrentSegment+1]-FCurrentElementPoints[FCurrentSegment])
     962    else
     963      segLen := 0;
     964    leftSpace := segLen*FCurrentSegmentPos;
     965    if (segLen > 0) and (remaining <= leftSpace) then
     966    begin
     967      FCurrentSegmentPos -= remaining/segLen;
     968      exit;
     969    end else
     970    begin
     971      remaining -= leftSpace;
     972      if FCurrentSegment > 0 then
     973      begin
     974        dec(FCurrentSegment);
     975        FCurrentSegmentPos := 1;
     976      end else
     977      begin
     978        FCurrentSegmentPos := 0;
     979        exit;
     980      end;
     981    end;
     982  end;
     983end;
     984
     985function TBGRAPathCursor.NeedPolygonalApprox: boolean;
     986begin
     987  if not (FCurrentElementType in[peQuadraticBezierTo,peCubicBezierTo,peArc,
     988  peOpenedSpline,peClosedSpline])
     989  then
     990  begin
     991    result := false;
     992    exit;
     993  end;
     994  result := true;
     995  if FCurrentElementPoints = nil then
     996  begin
     997    FCurrentElementPoints := Path.GetPolygonalApprox(FDataPos, FAcceptedDeviation, True);
     998    if FCurrentElementType = peQuadraticBezierTo then
     999    begin
     1000      if FCurrentElementLength <> 0 then
     1001        FCurrentElementArcPosScale := PolylineLen(FCurrentElementPoints)/FCurrentElementLength;
     1002    end;
     1003  end;
     1004end;
     1005
     1006function TBGRAPathCursor.GetArcPos: single;
     1007var pos: PtrInt;
     1008begin
     1009  if FArcPos = EmptySingle then
     1010  begin
     1011    FArcPos := FCurrentElementArcPos;
     1012    pos := FDataPos;
     1013    while Path.GoToPreviousElement(pos) do
     1014      FArcPos += Path.GetElementLength(pos, FAcceptedDeviation);
     1015  end;
     1016  result := FArcPos;
     1017end;
     1018
     1019function TBGRAPathCursor.GetCurrentTangent: TPointF;
     1020var idxStart,idxEnd: integer;
     1021  seg: TPointF;
     1022begin
     1023  while FCurrentElementLength <= 0 do
     1024  begin
     1025    if not GoToNextElement(False) then
     1026    begin
     1027      result := EmptyPointF;
     1028      exit;
     1029    end;
     1030  end;
     1031  case FCurrentElementType of
     1032    peMoveTo,peLineTo,peCloseSubPath:
     1033      result := (FCurrentElementEndCoord-FCurrentElementStartCoord)*(1/FCurrentElementLength);
     1034    peCubicBezierTo,peQuadraticBezierTo,peArc,peOpenedSpline,peClosedSpline:
     1035      begin
     1036        NeedPolygonalApprox;
     1037        idxStart := FCurrentSegment;
     1038        if idxStart >= high(FCurrentElementPoints) then
     1039          idxStart:= high(FCurrentElementPoints)-1;
     1040        idxEnd := idxStart+1;
     1041        if idxStart < 0 then
     1042        begin
     1043          result := EmptyPointF;
     1044          exit;
     1045        end;
     1046        seg := FCurrentElementPoints[idxEnd] - FCurrentElementPoints[idxStart];
     1047        while (seg.x = 0) and (seg.y = 0) and (idxEnd < high(FCurrentElementPoints)) do
     1048        begin
     1049          inc(idxEnd);
     1050          seg := FCurrentElementPoints[idxEnd] - FCurrentElementPoints[idxStart];
     1051        end;
     1052        while (seg.x = 0) and (seg.y = 0) and (idxStart > 0) do
     1053        begin
     1054          dec(idxStart);
     1055          seg := FCurrentElementPoints[idxEnd] - FCurrentElementPoints[idxStart];
     1056        end;
     1057        if (seg.x = 0) and (seg.y = 0) then
     1058          result := EmptyPointF
     1059        else
     1060          result := seg*(1/VectLen(seg));
     1061      end;
     1062    else result := EmptyPointF;
     1063  end;
     1064end;
     1065
     1066procedure TBGRAPathCursor.SetArcPos(AValue: single);
     1067var oldLoopClosedShapes,oldLoopPath: boolean;
     1068begin
     1069  if GetArcPos=AValue then Exit;
     1070  if (AValue > PathLength) and (PathLength <> 0) then
     1071    AValue := AValue - trunc(AValue/PathLength)*PathLength
     1072  else if (AValue < 0) then
     1073    AValue := AValue + (trunc(-AValue/PathLength)+1)*PathLength;
     1074  oldLoopClosedShapes:= LoopClosedShapes;
     1075  oldLoopPath:= LoopPath;
     1076  LoopClosedShapes:= false;
     1077  LoopPath:= false;
     1078  MoveForward(AValue-GetArcPos, True);
     1079  LoopClosedShapes:= oldLoopClosedShapes;
     1080  LoopPath:= oldLoopPath;
     1081end;
     1082
     1083function TBGRAPathCursor.GetPathLength: single;
     1084begin
     1085  if not FPathLengthComputed then
     1086  begin
     1087    FPathLength := Path.ComputeLength(FAcceptedDeviation);
     1088    FPathLengthComputed := true;
     1089  end;
     1090  result := FPathLength;
     1091end;
     1092
     1093procedure TBGRAPathCursor.OnPathFree;
     1094begin
     1095  FPath := nil;
     1096end;
     1097
     1098function TBGRAPathCursor.GetLoopClosedShapes: boolean;
     1099begin
     1100  result := FLoopClosedShapes;
     1101end;
     1102
     1103function TBGRAPathCursor.GetLoopPath: boolean;
     1104begin
     1105  result := FLoopPath;
     1106end;
     1107
     1108function TBGRAPathCursor.GetStartCoordinate: TPointF;
     1109begin
     1110  result := FStartCoordinate;
     1111end;
     1112
     1113procedure TBGRAPathCursor.SetLoopClosedShapes(AValue: boolean);
     1114begin
     1115  FLoopClosedShapes := AValue;
     1116end;
     1117
     1118procedure TBGRAPathCursor.SetLoopPath(AValue: boolean);
     1119begin
     1120  FLoopPath := AValue;
     1121end;
     1122
     1123procedure TBGRAPathCursor.PrepareCurrentElement;
     1124begin
     1125  Path.GetElementAt(FDataPos, FCurrentElementType, FCurrentElement);
     1126  FCurrentElementLength := 0;
     1127  FCurrentElementArcPos := 0;
     1128  FCurrentElementPoints := nil;
     1129  FCurrentSegment := 0;
     1130  FCurrentSegmentPos := 0;
     1131  FCurrentElementArcPosScale := 1;
     1132  if FCurrentElementType = peNone then
     1133  begin
     1134    FCurrentElementStartCoord := EmptyPointF;
     1135    FCurrentElementEndCoord := EmptyPointF;
     1136  end
     1137  else
     1138  begin
     1139    FCurrentElementStartCoord := Path.GetElementStartCoord(FDataPos);
     1140    case FCurrentElementType of
     1141      peLineTo, peCloseSubPath:
     1142        begin
     1143          FCurrentElementEndCoord := PPointF(FCurrentElement)^;
     1144          FCurrentElementLength := VectLen(FCurrentElementEndCoord - FCurrentElementStartCoord);
     1145        end;
     1146      peQuadraticBezierTo: with PQuadraticBezierToElement(FCurrentElement)^ do
     1147        begin
     1148          FCurrentElementEndCoord := Destination;
     1149          FCurrentElementLength := BGRABitmapTypes.BezierCurve(FCurrentElementStartCoord,ControlPoint,Destination).ComputeLength;
     1150        end;
     1151      peCubicBezierTo,peArc,peOpenedSpline,peClosedSpline:
     1152        begin
     1153          NeedPolygonalApprox;
     1154          FCurrentElementEndCoord := FCurrentElementPoints[high(FCurrentElementPoints)];
     1155          FCurrentElementLength := PolylineLen(FCurrentElementPoints);
     1156        end;
     1157    else
     1158      FCurrentElementEndCoord := FCurrentElementStartCoord;
     1159    end;
     1160  end;
     1161end;
     1162
     1163function TBGRAPathCursor.GetBounds: TRectF;
     1164begin
     1165  if not FBoundsComputed then
     1166  begin
     1167    FBounds:= Path.GetBounds(FAcceptedDeviation);
     1168    FBoundsComputed := true;
     1169  end;
     1170  result := FBounds;
     1171end;
     1172
     1173function TBGRAPathCursor.GoToNextElement(ACanJump: boolean): boolean;
     1174begin
     1175  if (FCurrentElementType = peCloseSubPath) and
     1176   (PClosePathElement(FCurrentElement)^.LoopDataPos <> -1) and
     1177   (  FLoopClosedShapes or
     1178      (FLoopPath and (PClosePathElement(FCurrentElement)^.LoopDataPos = 0))
     1179   ) then
     1180  begin
     1181    if PClosePathElement(FCurrentElement)^.LoopDataPos <> FDataPos then
     1182    begin
     1183      result := true;
     1184      FDataPos := PClosePathElement(FCurrentElement)^.LoopDataPos;
     1185      FArcPos := EmptySingle;
     1186      PrepareCurrentElement;
     1187    end else
     1188      result := false;
     1189  end;
     1190  if not ACanJump and ((FCurrentElementType = peCloseSubPath)
     1191   or (Path.PeekNextElement(FDataPos) = peMoveTo)) then
     1192  begin
     1193    result := false;
     1194    exit;
     1195  end;
     1196  if Path.GoToNextElement(FDataPos) then
     1197  begin
     1198    result := true;
     1199    PrepareCurrentElement;
     1200  end
     1201  else
     1202  begin
     1203    if ACanJump and FLoopPath and (FDataPos > 0) then
     1204    begin
     1205      result := true;
     1206      FDataPos := 0;
     1207      FArcPos := EmptySingle;
     1208      PrepareCurrentElement;
     1209    end else
     1210      result := false;
     1211  end;
     1212end;
     1213
     1214function TBGRAPathCursor.GoToPreviousElement(ACanJump: boolean): boolean;
     1215var lastElemPos: IntPtr;
     1216begin
     1217  if (FCurrentElementType = peMoveTo) and (PMoveToElement(FCurrentElement)^.LoopDataPos <> -1) and
     1218    ( FLoopClosedShapes or
     1219      (FLoopPath and (FDataPos = 0))
     1220    ) then
     1221  with PMoveToElement(FCurrentElement)^ do
     1222  begin
     1223    if LoopDataPos <> -1 then
     1224    begin
     1225      result := true;
     1226      FDataPos := LoopDataPos;
     1227      FArcPos := EmptySingle;
     1228      PrepareCurrentElement;
     1229    end;
     1230  end;
     1231  if not ACanJump and (FCurrentElementType = peMoveTo) then
     1232  begin
     1233    result := false;
     1234    exit;
     1235  end;
     1236  if Path.GoToPreviousElement(FDataPos) then
     1237  begin
     1238    result := true;
     1239    PrepareCurrentElement;
     1240  end
     1241  else
     1242  begin
     1243    if FLoopPath then
     1244    begin
     1245      lastElemPos := FPath.FDataPos;
     1246      if (lastElemPos > 0) and FPath.GoToPreviousElement(lastElemPos) then
     1247      begin
     1248        if lastElemPos > 0 then
     1249        begin
     1250          result := true;
     1251          FDataPos := lastElemPos;
     1252          PrepareCurrentElement;
     1253          FArcPos := EmptySingle;
     1254          exit;
     1255        end;
     1256      end;
     1257    end;
     1258    result := false;
     1259  end;
     1260end;
     1261
     1262constructor TBGRAPathCursor.Create(APath: TBGRAPath; AAcceptedDeviation: single);
     1263begin
     1264  FPath := APath;
     1265  FPathLengthComputed := false;
     1266  FBoundsComputed:= false;
     1267  FDataPos := 0;
     1268  FArcPos:= 0;
     1269  FAcceptedDeviation:= AAcceptedDeviation;
     1270  Path.RegisterCursor(self);
     1271  PrepareCurrentElement;
     1272
     1273  FStartCoordinate := FCurrentElementStartCoord;
     1274  if isEmptyPointF(FStartCoordinate) then
     1275    raise exception.Create('Path does not has a starting coordinate');
     1276  FEndCoordinate := Path.FLastTransformedCoord;
     1277  if isEmptyPointF(FEndCoordinate) then
     1278    raise exception.Create('Path does not has an ending coordinate');
     1279end;
     1280
     1281function TBGRAPathCursor.MoveForward(ADistance: single; ACanJump: boolean): single;
     1282var newArcPos,step,remaining: single;
     1283begin
     1284  if ADistance < 0 then
     1285  begin
     1286    result := -MoveBackward(-ADistance, ACanJump);
     1287    exit;
     1288  end;
     1289  result := 0;
     1290  remaining := ADistance;
     1291  while remaining > 0 do
     1292  begin
     1293    newArcPos := FCurrentElementArcPos + remaining;
     1294    if newArcPos > FCurrentElementLength then
     1295    begin
     1296      step := FCurrentElementLength - FCurrentElementArcPos;
     1297      result += step;
     1298      remaining -= step;
     1299      if not GoToNextElement(ACanJump) then
     1300      begin
     1301        MoveForwardInElement(step);
     1302        FCurrentElementArcPos := FCurrentElementLength;
     1303        FArcPos := PathLength;
     1304        exit;
     1305      end;
     1306    end else
     1307    begin
     1308      MoveForwardInElement(remaining);
     1309      FCurrentElementArcPos := newArcPos;
     1310      result := ADistance;
     1311      break;
     1312    end;
     1313  end;
     1314  if FArcPos <> EmptySingle then
     1315    FArcPos += result;
     1316end;
     1317
     1318function TBGRAPathCursor.MoveBackward(ADistance: single; ACanJump: boolean = true): single;
     1319var
     1320  remaining: Single;
     1321  newArcPos: Single;
     1322  step: Single;
     1323begin
     1324  if ADistance = 0 then
     1325  begin
     1326    result := 0;
     1327    exit;
     1328  end;
     1329  if ADistance < 0 then
     1330  begin
     1331    result := -MoveForward(-ADistance, ACanJump);
     1332    exit;
     1333  end;
     1334  result := 0;
     1335  remaining := ADistance;
     1336  while remaining > 0 do
     1337  begin
     1338    newArcPos := FCurrentElementArcPos - remaining;
     1339    if newArcPos < 0 then
     1340    begin
     1341      step := FCurrentElementArcPos;
     1342      result += step;
     1343      remaining -= step;
     1344      if not GoToPreviousElement(ACanJump) then
     1345      begin
     1346        MoveBackwardInElement(step);
     1347        FCurrentElementArcPos := 0;
     1348        FArcPos := 0;
     1349        exit;
     1350      end else
     1351        MoveToEndOfElement;
     1352    end else
     1353    begin
     1354      MoveBackwardInElement(remaining);
     1355      FCurrentElementArcPos := newArcPos;
     1356      result := ADistance;
     1357      break;
     1358    end;
     1359  end;
     1360  if FArcPos <> EmptySingle then
     1361    FArcPos -= result;
     1362end;
     1363
     1364destructor TBGRAPathCursor.Destroy;
     1365begin
     1366  if Assigned(FPath) then
     1367  begin
     1368    FPath.UnregisterCursor(self);
     1369  end;
     1370  inherited Destroy;
     1371end;
     1372
    7091373{ TBGRAPath }
     1374
     1375function TBGRAPath.ComputeLength(AAcceptedDeviation: single): single;
     1376var pos: PtrInt;
     1377begin
     1378  pos := 0;
     1379  result := 0;
     1380  repeat
     1381    result += GetElementLength(pos, AAcceptedDeviation);
     1382  until not GoToNextElement(pos);
     1383end;
     1384
     1385function TBGRAPath.ToPoints(AAcceptedDeviation: single): ArrayOfTPointF;
     1386var sub: array of ArrayOfTPointF;
     1387    temp: ArrayOfTPointF;
     1388    nbSub,nbPts,curPt,curSub: NativeInt;
     1389    startPos,pos: PtrInt;
     1390    elemType: TBGRAPathElementType;
     1391    elem: pointer;
     1392begin
     1393  pos := 0;
     1394  nbSub := 0;
     1395  repeat
     1396    GetElementAt(pos, elemType, elem);
     1397    if elem = nil then break;
     1398    case elemType of
     1399      peMoveTo,peLineTo,peCloseSubPath: begin
     1400          inc(nbSub);
     1401          while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
     1402            GoToNextElement(pos);
     1403        end;
     1404      peQuadraticBezierTo, peCubicBezierTo, peArc, peOpenedSpline, peClosedSpline: inc(nbSub);
     1405    end;
     1406  until not GoToNextElement(pos);
     1407
     1408  pos := 0;
     1409  setlength(sub, nbSub);
     1410  curSub := 0;
     1411  repeat
     1412    GetElementAt(pos, elemType, elem);
     1413    if elem = nil then break;
     1414    case elemType of
     1415      peMoveTo,peLineTo,peCloseSubPath: begin
     1416          startPos := pos;
     1417          if (elemType = peMoveTo) and (curSub > 0) then
     1418            nbPts := 2
     1419          else
     1420            nbPts := 1;
     1421          while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
     1422          begin
     1423            GoToNextElement(pos);
     1424            inc(nbPts);
     1425          end;
     1426          setlength(temp, nbPts);
     1427          pos := startPos;
     1428          if (elemType = peMoveTo) and (curSub > 0) then
     1429          begin
     1430            temp[0] := EmptyPointF;
     1431            temp[1] := PPointF(elem)^;
     1432            curPt := 2;
     1433          end else
     1434          begin
     1435            temp[0] := PPointF(elem)^;
     1436            curPt := 1;
     1437          end;
     1438          while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
     1439          begin
     1440            GoToNextElement(pos);
     1441            GetElementAt(pos, elemType, elem);
     1442            temp[curPt] := PPointF(elem)^;
     1443            inc(curPt);
     1444          end;
     1445          sub[curSub] := temp;
     1446          inc(curSub);
     1447          temp := nil;
     1448        end;
     1449      peQuadraticBezierTo,peCubicBezierTo,peArc,
     1450      peOpenedSpline, peClosedSpline:
     1451        begin
     1452          sub[curSub] := GetPolygonalApprox(pos, AAcceptedDeviation, False);
     1453          inc(curSub);
     1454        end;
     1455    end;
     1456  until not GoToNextElement(pos) or (curSub = nbSub);
     1457  result := ConcatPointsF(sub);
     1458end;
     1459
     1460function TBGRAPath.ToPoints(AMatrix: TAffineMatrix; AAcceptedDeviation: single): ArrayOfTPointF;
     1461begin
     1462  AAcceptedDeviation:= CorrectAcceptedDeviation(AAcceptedDeviation,AMatrix);
     1463  result := ToPoints(AAcceptedDeviation);
     1464  if not IsAffineMatrixIdentity(AMatrix) then
     1465    result := AMatrix*result;
     1466end;
     1467
     1468function TBGRAPath.IsEmpty: boolean;
     1469begin
     1470  result := FDataPos = 0;
     1471end;
     1472
     1473function TBGRAPath.GetBounds(AAcceptedDeviation: single): TRectF;
     1474var empty: boolean;
     1475    pos: PtrInt;
     1476    elemType: TBGRAPathElementType;
     1477    elem: pointer;
     1478    temp: array of TPointF;
     1479    i: integer;
     1480
     1481  procedure Include(pt: TPointF);
     1482  begin
     1483    if empty then
     1484    begin
     1485      result.TopLeft := pt;
     1486      result.BottomRight := pt;
     1487      empty := false;
     1488    end else
     1489    begin
     1490      if pt.x < result.Left then result.Left := pt.x
     1491      else if pt.x > result.Right then result.Right := pt.x;
     1492      if pt.y < result.Top then result.Top := pt.y
     1493      else if pt.y > result.Bottom then result.Bottom := pt.y;
     1494    end;
     1495  end;
     1496
     1497  procedure IncludeRect(r: TRectF);
     1498  begin
     1499    Include(r.TopLeft);
     1500    Include(r.BottomRight);
     1501  end;
     1502
     1503begin
     1504  empty := true;
     1505  result := RectF(0,0,0,0);
     1506  pos := 0;
     1507  repeat
     1508    GetElementAt(pos, elemType, elem);
     1509    if elem = nil then break;
     1510    case elemType of
     1511      peMoveTo,peLineTo,peCloseSubPath: begin
     1512          Include(PPointF(elem)^);
     1513          while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
     1514          begin
     1515            GoToNextElement(pos);
     1516            GetElementAt(pos, elemType, elem);
     1517            Include(PPointF(elem)^);
     1518          end;
     1519        end;
     1520      peCubicBezierTo:
     1521        with PCubicBezierToElement(elem)^ do
     1522          IncludeRect(BGRABitmapTypes.BezierCurve(GetElementStartCoord(pos),ControlPoint1,ControlPoint2,Destination).GetBounds);
     1523      peQuadraticBezierTo:
     1524        with PQuadraticBezierToElement(elem)^ do
     1525          IncludeRect(BGRABitmapTypes.BezierCurve(GetElementStartCoord(pos),ControlPoint,Destination).GetBounds);
     1526      peArc, peOpenedSpline, peClosedSpline:
     1527        begin
     1528          temp := GetPolygonalApprox(pos, AAcceptedDeviation, False);
     1529          for i := 0 to high(temp) do
     1530            Include(temp[i]);
     1531        end;
     1532    end;
     1533  until not GoToNextElement(pos);
     1534  if empty then raise exception.Create('Path is empty');
     1535end;
     1536
     1537procedure TBGRAPath.SetPoints(const APoints: ArrayOfTPointF);
     1538var i: integer;
     1539    nextIsMoveTo: boolean;
     1540    startPoint: TPointF;
     1541begin
     1542  beginPath;
     1543  if length(APoints) = 0 then exit;
     1544  NeedSpace((sizeof(TPathElementHeader)+sizeof(TPointF))*length(APoints));
     1545  nextIsMoveTo:= true;
     1546  startPoint := EmptyPointF;
     1547  for i := 0 to high(APoints) do
     1548  begin
     1549    if isEmptyPointF(APoints[i]) then
     1550      nextIsMoveTo:= true
     1551    else
     1552    if nextIsMoveTo then
     1553    begin
     1554      startPoint := APoints[i];
     1555      moveTo(startPoint);
     1556      nextIsMoveTo:= false;
     1557    end
     1558    else
     1559    begin
     1560      with APoints[i] do
     1561        if (x = startPoint.x) and (y = startPoint.y) then
     1562          closePath
     1563        else
     1564          lineTo(APoints[i]);
     1565    end;
     1566  end;
     1567end;
     1568
     1569procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel;
     1570  AWidth: single; AAcceptedDeviation: single);
     1571begin
     1572  stroke(ABitmap,AffineMatrixIdentity,AColor,AWidth,AAcceptedDeviation);
     1573end;
     1574
     1575procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner;
     1576  AWidth: single; AAcceptedDeviation: single);
     1577begin
     1578  stroke(ABitmap,AffineMatrixIdentity,ATexture,AWidth,AAcceptedDeviation);
     1579end;
     1580
     1581procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; x, y: single;
     1582  AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single);
     1583begin
     1584  stroke(ABitmap,AffineMatrixTranslation(x,y),AColor,AWidth,AAcceptedDeviation);
     1585end;
     1586
     1587procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; x, y: single;
     1588  ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single);
     1589begin
     1590  stroke(ABitmap,AffineMatrixTranslation(x,y),ATexture,AWidth,AAcceptedDeviation);
     1591end;
     1592
     1593procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix;
     1594  AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single);
     1595var data: TStrokeData;
     1596begin
     1597  data.Bitmap := ABitmap;
     1598  data.Texture := nil;
     1599  data.Color := AColor;
     1600  data.Width := AWidth;
     1601  InternalDraw(@BitmapDrawSubPathProc, AMatrix, AAcceptedDeviation, @data);
     1602end;
     1603
     1604procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix;
     1605  ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single);
     1606var data: TStrokeData;
     1607begin
     1608  data.Bitmap := ABitmap;
     1609  data.Texture := ATexture;
     1610  data.Color := BGRAPixelTransparent;
     1611  data.Width := AWidth;
     1612  InternalDraw(@BitmapDrawSubPathProc, AMatrix, AAcceptedDeviation, @data);
     1613end;
     1614
     1615procedure TBGRAPath.stroke(ADrawProc: TBGRAPathDrawProc;
     1616  const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer);
     1617begin
     1618  InternalDraw(ADrawProc,AMatrix,AAcceptedDeviation,AData);
     1619end;
     1620
     1621procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel;
     1622  AAcceptedDeviation: single);
     1623begin
     1624  fill(ABitmap,AffineMatrixIdentity,AColor,AAcceptedDeviation);
     1625end;
     1626
     1627procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner;
     1628  AAcceptedDeviation: single);
     1629begin
     1630  fill(ABitmap,AffineMatrixIdentity,ATexture,AAcceptedDeviation);
     1631end;
     1632
     1633procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; x, y: single;
     1634  AColor: TBGRAPixel; AAcceptedDeviation: single);
     1635begin
     1636  fill(ABitmap,AffineMatrixTranslation(x,y),AColor,AAcceptedDeviation);
     1637end;
     1638
     1639procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; x, y: single;
     1640  ATexture: IBGRAScanner; AAcceptedDeviation: single);
     1641begin
     1642  fill(ABitmap,AffineMatrixTranslation(x,y),ATexture,AAcceptedDeviation);
     1643end;
     1644
     1645procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix;
     1646  AColor: TBGRAPixel; AAcceptedDeviation: single);
     1647begin
     1648  ABitmap.FillPolyAntialias(ToPoints(AMatrix,AAcceptedDeviation), AColor);
     1649end;
     1650
     1651procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix;
     1652  ATexture: IBGRAScanner; AAcceptedDeviation: single);
     1653begin
     1654  ABitmap.FillPolyAntialias(ToPoints(AMatrix,AAcceptedDeviation), ATexture);
     1655end;
     1656
     1657procedure TBGRAPath.fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix;
     1658  AAcceptedDeviation: single; AData: pointer);
     1659begin
     1660  AFillProc(ToPoints(AMatrix,AAcceptedDeviation), AData);
     1661end;
     1662
     1663function TBGRAPath.CreateCursor(AAcceptedDeviation: single): TBGRAPathCursor;
     1664begin
     1665  result := TBGRAPathCursor.Create(self, AAcceptedDeviation);
     1666end;
     1667
     1668procedure TBGRAPath.Fit(ARect: TRectF; AAcceptedDeviation: single);
     1669var
     1670  temp: TBGRAPath;
     1671begin
     1672  temp := TBGRAPath.Create;
     1673  copyTo(temp);
     1674  temp.FitInto(self, ARect, AAcceptedDeviation);
     1675  temp.Free;
     1676end;
     1677
     1678procedure TBGRAPath.FitInto(ADest: TBGRAPath; ARect: TRectF;
     1679  AAcceptedDeviation: single);
     1680var bounds: TRectF;
     1681    zoomX,zoomY: single;
     1682begin
     1683  bounds := GetBounds(AAcceptedDeviation);
     1684  ADest.beginPath;
     1685  ADest.translate((ARect.Left+ARect.Right)*0.5, (ARect.Bottom+ARect.Top)*0.5);
     1686  if bounds.Right-bounds.Left <> 0 then
     1687  begin
     1688    zoomX := (ARect.Right-ARect.Left)/(bounds.Right-bounds.Left);
     1689    if bounds.Bottom-bounds.Top > 0 then
     1690    begin
     1691      zoomY := (ARect.Bottom-ARect.Top)/(bounds.Bottom-bounds.Top);
     1692      if zoomY < zoomX then ADest.scale(zoomY) else ADest.scale(zoomX);
     1693    end else
     1694      ADest.scale(zoomX);
     1695  end else
     1696  if bounds.Bottom-bounds.Top > 0 then
     1697  begin
     1698    zoomY := (ARect.Bottom-ARect.Top)/(bounds.Bottom-bounds.Top);
     1699    ADest.scale(zoomY);
     1700  end;
     1701  ADest.translate(-(bounds.Left+bounds.Right)*0.5, -(bounds.Bottom+bounds.Top)*0.5);
     1702  copyTo(ADest);
     1703  ADest.resetTransform;
     1704end;
    7101705
    7111706function TBGRAPath.GetSvgString: string;
    7121707const RadToDeg = 180/Pi;
    713 var savedPos: integer;
    714     a: TArcDef;
    715     formats: TFormatSettings;
    716     lastPos,p1: TPointF;
    717     implicitCommand: char;
     1708var
     1709  formats: TFormatSettings;
     1710  lastPosF: TPointF;
     1711  implicitCommand: char;
    7181712
    7191713  function FloatToString(value: single): string;
    … …  
    7241718  function CoordToString(const pt: TPointF): string;
    7251719  begin
    726     lastPos := pt;
     1720    lastPosF := pt;
    7271721    result := FloatToString(pt.x)+FloatToString(pt.y);
    7281722  end;
    … …  
    7451739  end;
    7461740
    747 var param: string;
    748 
     1741var elemType: TBGRAPathElementType;
     1742    elem: pointer;
     1743    a: PArcElement;
     1744    Pos: PtrInt;
     1745    p1: TPointF;
     1746    pts: array of TPointF;
     1747    i: integer;
    7491748begin
    7501749  formats := DefaultFormatSettings;
    … …  
    7521751
    7531752  result := '';
    754   savedPos:= FDataPos;
    755   FDataPos := 0;
    756   lastPos := EmptyPointF;
     1753  Pos := 0;
     1754  lastPosF := EmptyPointF;
    7571755  implicitCommand := #0;
    758   while FDataPos < savedPos do
    759   begin
    760     case ReadElementType of
    761     peMoveTo: addCommand('M',CoordToString(ReadCoord));
    762     peLineTo: addCommand('L',CoordToString(ReadCoord));
    763     peCloseSubPath: addCommand('z','');
    764     peQuadraticBezierTo:
    765       begin
    766         param := CoordToString(ReadCoord);
    767         param += CoordToString(ReadCoord);
    768         addCommand('Q',param);
    769       end;
    770     peCubicBezierTo:
    771       begin
    772         param := CoordToString(ReadCoord);
    773         param += CoordToString(ReadCoord);
    774         param += CoordToString(ReadCoord);
    775         addCommand('C',param);
    776       end;
    777     peArc:
    778       begin
    779         a := ReadArcDef;
    780         p1 := ArcStartPoint(a);
    781         if isEmptyPointF(lastPos) or (p1 <> lastPos) then
    782           addCommand('L',CoordToString(p1));
    783         param := CoordToString(a.radius);
    784         param += FloatToString(a.xAngleRadCW*RadToDeg);
    785         param += BoolToString(IsLargeArc(a));
    786         param += BoolToString(not a.anticlockwise);
    787         param += CoordToString(ArcEndPoint(a));
    788         addCommand('A',param);
    789       end;
    790     end;
    791   end;
    792   FDataPos := savedPos;
     1756  repeat
     1757    GetElementAt(Pos, elemType, elem);
     1758    if elem = nil then break;
     1759    case elemType of
     1760      peMoveTo: addCommand('M',CoordToString(PPointF(elem)^));
     1761      peLineTo: addCommand('L',CoordToString(PPointF(elem)^));
     1762      peCloseSubPath: addCommand('z','');
     1763      peQuadraticBezierTo:
     1764        with PQuadraticBezierToElement(elem)^ do
     1765          addCommand('Q',CoordToString(ControlPoint)+CoordToString(Destination));
     1766      peCubicBezierTo:
     1767        with PCubicBezierToElement(elem)^ do
     1768          addCommand('C',CoordToString(ControlPoint1)+
     1769               CoordToString(ControlPoint2)+CoordToString(Destination));
     1770      peArc:
     1771        begin
     1772          a := PArcElement(elem);
     1773          p1 := ArcStartPoint(a^);
     1774          if isEmptyPointF(lastPosF) or (p1 <> lastPosF) then
     1775            addCommand('L',CoordToString(p1));
     1776          addCommand('A',CoordToString(a^.radius)+
     1777             FloatToString(a^.xAngleRadCW*RadToDeg)+
     1778             BoolToString(IsLargeArc(a^))+
     1779             BoolToString(not a^.anticlockwise)+
     1780             CoordToString(ArcEndPoint(a^)));
     1781        end;
     1782      peOpenedSpline, peClosedSpline:
     1783        begin
     1784          pts := GetPolygonalApprox(Pos, 0.1,True);
     1785          for i := 0 to high(pts) do
     1786          begin
     1787            if isEmptyPointF(lastPosF) then
     1788              addCommand('M',CoordToString(pts[i]))
     1789            else
     1790              addCommand('L',CoordToString(pts[i]));
     1791          end;
     1792        end;
     1793    end;
     1794  until not GoToNextElement(Pos);
    7931795end;
    7941796
    … …  
    8001802end;
    8011803
     1804procedure TBGRAPath.RegisterCursor(ACursor: TBGRAPathCursor);
     1805begin
     1806  setlength(FCursors, length(FCursors)+1);
     1807  FCursors[high(FCursors)] := ACursor;
     1808end;
     1809
     1810procedure TBGRAPath.UnregisterCursor(ACursor: TBGRAPathCursor);
     1811var
     1812  i,j: Integer;
     1813begin
     1814  for i := high(FCursors) downto 0 do
     1815    if FCursors[i] = ACursor then
     1816    begin
     1817      for j := i to high(FCursors)-1 do
     1818        FCursors[j] := FCursors[j+1];
     1819      setlength(FCursors, length(FCursors)-1);
     1820      exit;
     1821    end;
     1822end;
     1823
     1824function TBGRAPath.SetLastCoord(ACoord: TPointF): TPointF;
     1825begin
     1826  FLastCoord := ACoord;
     1827  FLastTransformedCoord := FMatrix*ACoord;
     1828  result := FLastTransformedCoord;
     1829end;
     1830
     1831procedure TBGRAPath.ClearLastCoord;
     1832begin
     1833  FLastCoord := EmptyPointF;
     1834  FLastTransformedCoord := EmptyPointF;
     1835end;
     1836
     1837procedure TBGRAPath.BezierCurveFromTransformed(tcp1, cp2, pt: TPointF);
     1838begin
     1839  with PCubicBezierToElement(AllocateElement(peCubicBezierTo))^ do
     1840  begin
     1841    ControlPoint1 := tcp1;
     1842    ControlPoint2 := FMatrix*cp2;
     1843    Destination := SetLastCoord(pt);
     1844    FExpectedTransformedControlPoint := Destination + (Destination-ControlPoint2);
     1845  end;
     1846end;
     1847
     1848procedure TBGRAPath.QuadraticCurveFromTransformed(tcp, pt: TPointF);
     1849begin
     1850  with PQuadraticBezierToElement(AllocateElement(peQuadraticBezierTo))^ do
     1851  begin
     1852    ControlPoint := tcp;
     1853    Destination := SetLastCoord(pt);
     1854    FExpectedTransformedControlPoint := Destination+(Destination-ControlPoint);
     1855  end;
     1856end;
     1857
     1858function TBGRAPath.LastCoordDefined: boolean;
     1859begin
     1860  result := not isEmptyPointF(FLastTransformedCoord);
     1861end;
     1862
     1863function TBGRAPath.GetPolygonalApprox(APos: IntPtr; AAcceptedDeviation: single; AIncludeFirstPoint: boolean): ArrayOfTPointF;
     1864var pts: ArrayOfTPointF;
     1865  elemType: TBGRAPathElementType;
     1866  elem: pointer;
     1867  pt : TPointF;
     1868  i: NativeInt;
     1869begin
     1870  GetElementAt(APos, elemType, elem);
     1871  case elemType of
     1872    peQuadraticBezierTo:
     1873      with PQuadraticBezierToElement(elem)^ do
     1874        result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint,Destination).ToPoints(AAcceptedDeviation, AIncludeFirstPoint);
     1875    peCubicBezierTo:
     1876      with PCubicBezierToElement(elem)^ do
     1877        result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint1,ControlPoint2,Destination).ToPoints(AAcceptedDeviation, AIncludeFirstPoint);
     1878    peArc:
     1879      begin
     1880        result := ComputeArc(PArcElement(elem)^, 0.1/AAcceptedDeviation);
     1881        pt := GetElementStartCoord(APos);
     1882        if pt <> result[0] then
     1883        begin
     1884          setlength(result, length(result)+1);
     1885          for i := high(result) downto 1 do
     1886            result[i] := result[i-1];
     1887          result[0] := pt;
     1888        end;
     1889      end;
     1890    peOpenedSpline, peClosedSpline:
     1891      with PSplineElement(elem)^ do
     1892      begin
     1893        setlength(pts, NbControlPoints);
     1894        move(Pointer(PSplineElement(elem)+1)^, pts[0], NbControlPoints*sizeof(TPointF));
     1895        if elemType = peOpenedSpline then
     1896          result := ComputeOpenedSpline(pts, SplineStyle, 0.25, AAcceptedDeviation)
     1897        else
     1898          result := ComputeClosedSpline(pts, SplineStyle, AAcceptedDeviation);
     1899      end;
     1900  end;
     1901end;
     1902
     1903function TBGRAPath.getPoints: ArrayOfTPointF;
     1904begin
     1905  result := ToPoints;
     1906end;
     1907
     1908function TBGRAPath.getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF;
     1909begin
     1910  result := ToPoints(AMatrix);
     1911end;
     1912
     1913function TBGRAPath.getCursor: TBGRACustomPathCursor;
     1914begin
     1915  result := CreateCursor;
     1916end;
     1917
     1918procedure TBGRAPath.InternalDraw(ADrawProc: TBGRAPathDrawProc;
     1919  const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer);
     1920var
     1921  nbSub: NativeInt;
     1922
     1923  procedure OutputSub(subPathStartPos, subPathEndPos: IntPtr);
     1924  var
     1925    sub: array of ArrayOfTPointF;
     1926    temp: ArrayOfTPointF;
     1927    startPos,pos,nbPts,curPt,curSub: NativeInt;
     1928    elemType: TBGRAPathElementType;
     1929    elem: pointer;
     1930  begin
     1931    pos := subPathStartPos;
     1932    setlength(sub, nbSub);
     1933    curSub := 0;
     1934    while (pos <= subPathEndPos) and (curSub < nbSub) do
     1935    begin
     1936      GetElementAt(pos, elemType, elem);
     1937      if elem = nil then break;
     1938      case elemType of
     1939        peMoveTo,peLineTo,peCloseSubPath: begin
     1940            startPos := pos;
     1941            if (elemType = peMoveTo) and (curSub > 0) then
     1942              nbPts := 2
     1943            else
     1944              nbPts := 1;
     1945            while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
     1946            begin
     1947              GoToNextElement(pos);
     1948              inc(nbPts);
     1949            end;
     1950            setlength(temp, nbPts);
     1951            pos := startPos;
     1952            if (elemType = peMoveTo) and (curSub > 0) then
     1953            begin
     1954              temp[0] := EmptyPointF;
     1955              temp[1] := PPointF(elem)^;
     1956              curPt := 2;
     1957            end else
     1958            begin
     1959              temp[0] := PPointF(elem)^;
     1960              curPt := 1;
     1961            end;
     1962            while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
     1963            begin
     1964              GoToNextElement(pos);
     1965              GetElementAt(pos, elemType, elem);
     1966              temp[curPt] := PPointF(elem)^;
     1967              inc(curPt);
     1968            end;
     1969            sub[curSub] := temp;
     1970            inc(curSub);
     1971            temp := nil;
     1972          end;
     1973        peQuadraticBezierTo,peCubicBezierTo,peArc,
     1974        peOpenedSpline, peClosedSpline:
     1975          begin
     1976            sub[curSub] := GetPolygonalApprox(pos, AAcceptedDeviation, False);
     1977            inc(curSub);
     1978          end;
     1979      end;
     1980      GoToNextElement(pos);
     1981    end;
     1982    temp := ConcatPointsF(sub);
     1983    if not IsAffineMatrixIdentity(AMatrix) then
     1984      temp := AMatrix*temp;
     1985    if (elemType = peCloseSubPath) or ((curSub = 2) and (elemType = peClosedSpline)) then
     1986      ADrawProc(temp, True, AData)
     1987    else
     1988      ADrawProc(temp, False, AData);
     1989  end;
     1990
     1991var
     1992  subPathStartPos: IntPtr;
     1993  prevPos,pos: PtrInt;
     1994  elemType: TBGRAPathElementType;
     1995  elem: pointer;
     1996begin
     1997  AAcceptedDeviation := CorrectAcceptedDeviation(AAcceptedDeviation, AMatrix);
     1998  pos := 0;
     1999  nbSub := 0;
     2000  subPathStartPos := pos;
     2001  repeat
     2002    prevPos := pos;
     2003    GetElementAt(pos, elemType, elem);
     2004    if elem = nil then
     2005    begin
     2006      pos := prevPos;
     2007      break;
     2008    end;
     2009    if (elemType = peMoveTo) and (nbSub > 0) then
     2010    begin
     2011      OutputSub(subPathStartPos,prevPos);
     2012      nbSub := 0;
     2013      subPathStartPos := pos;
     2014    end;
     2015    case elemType of
     2016      peMoveTo,peLineTo,peCloseSubPath: begin
     2017          inc(nbSub);
     2018          while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
     2019            GoToNextElement(pos);
     2020        end;
     2021      peQuadraticBezierTo, peCubicBezierTo, peArc, peOpenedSpline, peClosedSpline: inc(nbSub);
     2022    end;
     2023  until not GoToNextElement(pos);
     2024  if nbSub > 0 then OutputSub(subPathStartPos,pos);
     2025end;
     2026
    8022027procedure TBGRAPath.addPath(const AValue: string);
    8032028var p: integer;
    8042029    numberError: boolean;
     2030    startCoord,lastCoord: TPointF;
    8052031
    8062032  function parseFloat: single;
    … …  
    8122038    if (p <= length(AValue)) and (AValue[p] in['+','-']) then inc(p);
    8132039    while (p <= length(AValue)) and (AValue[p] in['0'..'9','.']) do inc(p);
    814     if (p <= length(AValue)) and (AValue[p] in['e','E']) then inc(p);
    815     if (p <= length(AValue)) and (AValue[p] in['+','-']) then inc(p);
    816     while (p <= length(AValue)) and (AValue[p] in['0'..'9','.']) do inc(p);
     2040    if (p <= length(AValue)) and (AValue[p] in['e','E']) then
     2041    begin
     2042      inc(p);
     2043      if (p <= length(AValue)) and (AValue[p] in['+','-']) then inc(p);
     2044      while (p <= length(AValue)) and (AValue[p] in['0'..'9','.']) do inc(p);
     2045    end;
    8172046    val(copy(AValue,numberStart,p-numberStart),result,errPos);
    8182047    if errPos <> 0 then numberError := true;
    … …  
    8212050  function parseCoord(relative: boolean): TPointF;
    8222051  begin
    823     result := PointF(parseFloat,parseFloat);
    824     if relative and not isEmptyPointF(FLastCoord) then result += FLastCoord;
     2052    result.x := parseFloat;
     2053    result.y := parseFloat;
     2054    if relative and not isEmptyPointF(lastCoord) then result += lastCoord;
     2055    if isEmptyPointF(lastCoord) then startCoord := result;
    8252056  end;
    8262057
    … …  
    8322063  largeArc: boolean;
    8332064begin
    834   FLastCoord := EmptyPointF;
    835   FStartCoord := EmptyPointF;
     2065  BeginSubPath;
     2066  lastCoord := EmptyPointF;
     2067  startCoord := EmptyPointF;
    8362068  p := 1;
    8372069  implicitCommand:= #0;
    … …  
    8532085           closePath;
    8542086           implicitCommand:= #0;
     2087           lastCoord := startCoord;
    8552088         end;
    8562089    'M': begin
    8572090           p1 := parseCoord(relative);
    858            if not numberError then moveTo(p1);
     2091           if not numberError then
     2092           begin
     2093             moveTo(p1);
     2094             lastCoord := p1;
     2095           end;
    8592096           if relative then implicitCommand:= 'l' else
    8602097             implicitCommand:= 'L';
    … …  
    8622099    'L': begin
    8632100           p1 := parseCoord(relative);
    864            if not numberError then lineTo(p1);
     2101           if not numberError then
     2102           begin
     2103             lineTo(p1);
     2104             lastCoord := p1;
     2105           end;
    8652106      end;
    8662107    'H': begin
    867         if not isEmptyPointF(FLastCoord) then p1 := FLastCoord
    868         else p1 := PointF(0,0);
    869         if relative then p1.x += parseFloat
    870         else p1.x := parseFloat;
    871         if not numberError then lineTo(p1);
     2108        if not isEmptyPointF(lastCoord) then
     2109        begin
     2110          p1 := lastCoord;
     2111          if relative then p1.x += parseFloat
     2112          else p1.x := parseFloat;
     2113        end else
     2114        begin
     2115          p1 := PointF(parseFloat,0);
     2116          lastCoord := p1;
     2117          startCoord := p1;
     2118        end;
     2119        if not numberError then
     2120        begin
     2121          lineTo(p1);
     2122          lastCoord := p1;
     2123        end;
    8722124      end;
    8732125    'V': begin
    874         if not isEmptyPointF(FLastCoord) then p1 := FLastCoord
    875         else p1 := PointF(0,0);
    876         if relative then p1.y += parseFloat
    877         else p1.y := parseFloat;
    878         if not numberError then lineTo(p1);
     2126        if not isEmptyPointF(lastCoord) then
     2127        begin
     2128          p1 := lastCoord;
     2129          if relative then p1.y += parseFloat
     2130          else p1.y := parseFloat;
     2131        end else
     2132        begin
     2133          p1 := PointF(0,parseFloat);
     2134          lastCoord := p1;
     2135          startCoord := p1;
     2136        end;
     2137        if not numberError then
     2138        begin
     2139          lineTo(p1);
     2140          lastCoord := p1;
     2141        end;
    8792142      end;
    8802143    'C': begin
    … …  
    8822145        c2 := parseCoord(relative);
    8832146        p1 := parseCoord(relative);
    884         if not numberError then bezierCurveTo(c1,c2,p1);
     2147        if not numberError then
     2148        begin
     2149          bezierCurveTo(c1,c2,p1);
     2150          lastCoord := p1;
     2151        end;
    8852152      end;
    8862153    'S': begin
    8872154        c2 := parseCoord(relative);
    8882155        p1 := parseCoord(relative);
    889         if not numberError then smoothBezierCurveTo(c2,p1);
     2156        if not numberError then
     2157        begin
     2158          smoothBezierCurveTo(c2,p1);
     2159          lastCoord := p1;
     2160        end;
    8902161      end;
    8912162    'Q': begin
    8922163        c1 := parseCoord(relative);
    8932164        p1 := parseCoord(relative);
    894         if not numberError then quadraticCurveTo(c1,p1);
     2165        if not numberError then
     2166        begin
     2167          quadraticCurveTo(c1,p1);
     2168          lastCoord := p1;
     2169        end;
    8952170      end;
    8962171    'T': begin
    8972172        p1 := parseCoord(relative);
    898         if not numberError then smoothQuadraticCurveTo(p1);
    899       end;
    900     'A': begin
    901         a.radius := parseCoord(false);
     2173        if not numberError then
     2174        begin
     2175          smoothQuadraticCurveTo(p1);
     2176          lastCoord := p1;
     2177        end;
     2178    end;
     2179    'A':
     2180      begin
     2181        a.radius.x := parseFloat;
     2182        a.radius.y := parseFloat;
    9022183        a.xAngleRadCW := parseFloat*Pi/180;
    9032184        largeArc := parseFloat<>0;
    9042185        a.anticlockwise:= parseFloat=0;
    9052186        p1 := parseCoord(relative);
    906         arcTo(a.radius.x,a.radius.y,a.xAngleRadCW,largeArc,a.anticlockwise,p1.x,p1.y);
     2187        if not numberError then
     2188        begin
     2189          arcTo(a.radius.x,a.radius.y,a.xAngleRadCW,largeArc,a.anticlockwise,p1.x,p1.y);
     2190          lastCoord := p1;
     2191        end;
    9072192      end;
    9082193    end;
    … …  
    9152200end;
    9162201
     2202procedure TBGRAPath.openedSpline(const pts: array of TPointF;
     2203  style: TSplineStyle);
     2204var elem: PSplineElement;
     2205  i: NativeInt;
     2206  p: PPointF;
     2207begin
     2208  if length(pts) <= 2 then
     2209  begin
     2210    polyline(pts);
     2211    exit;
     2212  end;
     2213  if not LastCoordDefined then moveTo(pts[0]);
     2214  elem := AllocateElement(peOpenedSpline, length(pts)*sizeof(TPointF));
     2215  elem^.NbControlPoints := length(pts);
     2216  elem^.SplineStyle := style;
     2217  p := PPointF(elem+1);
     2218  for i := 0 to high(pts)-1 do
     2219  begin
     2220    p^ := FMatrix*pts[i];
     2221    inc(p);
     2222  end;
     2223  p^ := SetLastCoord(pts[high(pts)]);
     2224  inc(p);
     2225  PInteger(p)^ := length(pts);
     2226end;
     2227
     2228procedure TBGRAPath.closedSpline(const pts: array of TPointF;
     2229  style: TSplineStyle);
     2230var elem: PSplineElement;
     2231  i: NativeInt;
     2232  p: PPointF;
     2233begin
     2234  if length(pts) = 0 then exit;
     2235  if not LastCoordDefined then moveTo(ClosedSplineStartPoint(pts, style));
     2236  if length(pts) <= 2 then exit;
     2237  elem := AllocateElement(peClosedSpline, length(pts)*sizeof(TPointF));
     2238  elem^.NbControlPoints := length(pts);
     2239  elem^.SplineStyle := style;
     2240  p := PPointF(elem+1);
     2241  for i := 0 to high(pts) do
     2242  begin
     2243    p^ := FMatrix*pts[i];
     2244    inc(p);
     2245  end;
     2246  PInteger(p)^ := length(pts);
     2247end;
     2248
     2249procedure TBGRAPath.BitmapDrawSubPathProc(const APoints: array of TPointF;
     2250  AClosed: boolean; AData: pointer);
     2251begin
     2252  with TStrokeData(AData^) do
     2253  if AClosed then
     2254  begin
     2255    if Texture <> nil then
     2256      Bitmap.DrawPolygonAntialias(APoints, Texture, Width)
     2257    else
     2258      Bitmap.DrawPolygonAntialias(APoints, Color, Width);
     2259  end else
     2260  begin
     2261    if Texture <> nil then
     2262      Bitmap.DrawPolyLineAntialiasAutocycle(APoints, Texture, Width)
     2263    else
     2264      Bitmap.DrawPolyLineAntialiasAutocycle(APoints, Color, Width);
     2265  end;
     2266end;
     2267
     2268function TBGRAPath.CorrectAcceptedDeviation(AAcceptedDeviation: single;
     2269  const AMatrix: TAffineMatrix): single;
     2270var maxZoom: single;
     2271begin
     2272  //determine the zoom of the matrix
     2273  maxZoom := Max(VectLen(PointF(AMatrix[1,1],AMatrix[2,1])),
     2274     VectLen(PointF(AMatrix[1,2],AMatrix[2,2])));
     2275  //make the accepted deviation smaller if the matrix zooms to avoid that
     2276  // curves would look angular
     2277  if maxZoom = 0 then
     2278    result:= 1e10
     2279  else
     2280    result := AAcceptedDeviation / maxZoom;
     2281end;
     2282
     2283procedure TBGRAPath.OnModify;
     2284begin
     2285  if length(FCursors)> 0 then
     2286      raise Exception.Create('You cannot modify the path when there are cursors');
     2287end;
     2288
     2289procedure TBGRAPath.OnMatrixChange;
     2290begin
     2291  //transformed coord are not changed,
     2292  //but original coords are lost in the process.
     2293  //this has a consequence when using
     2294  //arc functions that rely on the previous
     2295  //coordinate
     2296  FLastCoord := EmptyPointF;
     2297  FSubPathStartCoord := EmptyPointF;
     2298end;
     2299
    9172300procedure TBGRAPath.NeedSpace(count: integer);
    9182301begin
    919   if FDataPos + count > FDataSize then
    920   begin
    921     FDataSize := FDataSize*2+8;
    922     ReAllocMem(FData, FDataSize);
    923   end;
    924 end;
    925 
    926 procedure TBGRAPath.StoreCoord(const pt: TPointF);
    927 begin
    928   NeedSpace(sizeof(single)*2);
    929   with FMatrix*pt do
    930   begin
    931     PSingle(FData+FDataPos)^ := x;
    932     PSingle(FData+FDataPos+sizeof(single))^ := y;
    933   end;
    934   Inc(FDataPos, sizeof(single)*2);
    935   FLastCoord := pt;
    936 end;
    937 
    938 function TBGRAPath.ReadCoord: TPointF;
    939 begin
    940   result := PPointF(FData+FDataPos)^;
    941   inc(FDataPos,sizeof(TPointF));
    942 end;
    943 
    944 procedure TBGRAPath.StoreElementType(value: TBGRAPathElementType);
    945 begin
    946   NeedSpace(sizeof(TBGRAPathElementType));
    947   PBGRAPathElementType(FData+FDataPos)^ := value;
    948   Inc(FDataPos, sizeof(TBGRAPathElementType));
    949   FLastElementType:= value;
    950 end;
    951 
    952 function TBGRAPath.ReadElementType: TBGRAPathElementType;
    953 begin
    954   result := PBGRAPathElementType(FData+FDataPos)^;
    955   inc(FDataPos,sizeof(TBGRAPathElementType));
    956 end;
    957 
    958 function TBGRAPath.ReadArcDef: TArcDef;
    959 begin
    960   result := PArcDef(FData+FDataPos)^;
    961   inc(FDataPos,sizeof(TArcDef));
    962 end;
    963 
    964 procedure TBGRAPath.RewindFloat;
    965 begin
    966   if FDataPos >= sizeof(single) then dec(FDataPos, sizeof(Single));
     2302  OnModify;
     2303  if FDataPos + count > FDataCapacity then
     2304  begin
     2305    FDataCapacity := (FDataCapacity shl 1)+8;
     2306    if FDataPos + count + 8 > FDataCapacity then
     2307      FDataCapacity := FDataPos + count + 8;
     2308    ReAllocMem(FData, FDataCapacity);
     2309  end;
     2310end;
     2311
     2312function TBGRAPath.AllocateElement(AElementType: TBGRAPathElementType;
     2313  AExtraBytes: PtrInt): Pointer;
     2314var t: PtrInt;
     2315begin
     2316  if not (AElementType in [succ(peNone)..high(TBGRAPathElementType)]) then
     2317    raise exception.Create('Invalid element type');
     2318  OnModify;
     2319  t := PathElementSize[AElementType]+AExtraBytes;
     2320  NeedSpace(SizeOf(TPathElementHeader)+t);
     2321  with PPathElementHeader(FData+FDataPos)^ do
     2322  begin
     2323    ElementType:= AElementType;
     2324    PreviousElementType := FLastStoredElementType;
     2325  end;
     2326  result := FData+(FDataPos+SizeOf(TPathElementHeader));
     2327  FLastSubPathElementType:= AElementType;
     2328  FLastStoredElementType:= AElementType;
     2329  Inc(FDataPos, sizeof(TPathElementHeader)+t);
    9672330end;
    9682331
    … …  
    9702333begin
    9712334  FData := nil;
    972   FDataSize := 0;
    973   FDataPos := 0;
    974   FLastElementType := peNone;
    975   FLastCoord := EmptyPointF;
    976   FStartCoord := EmptyPointF;
    977   FExpectedControlPoint := EmptyPointF;
     2335  FDataCapacity := 0;
     2336  FLastMoveToDataPos := -1;
     2337  beginPath;
    9782338  resetTransform;
     2339end;
     2340
     2341function TBGRAPath.GoToNextElement(var APos: PtrInt): boolean;
     2342var newPos: PtrInt;
     2343  p: PSplineElement;
     2344  elemType: TBGRAPathElementType;
     2345begin
     2346  if APos >= FDataPos then
     2347    result := false
     2348  else
     2349  begin
     2350    elemType := PPathElementHeader(FData+APos)^.ElementType;
     2351    newPos := APos + sizeof(TPathElementHeader) + PathElementSize[elemType];
     2352    if elemType in[peOpenedSpline,peClosedSpline] then
     2353    begin
     2354      p := PSplineElement(FData+(APos+sizeof(TPathElementHeader)));
     2355      newPos += p^.NbControlPoints * sizeof(TPointF); //extra
     2356    end;
     2357    if newPos < FDataPos then
     2358    begin
     2359      result := true;
     2360      APos := newPos;
     2361      if not CheckElementType(PPathElementHeader(FData+APos)^.ElementType) or
     2362        not CheckElementType(PPathElementHeader(FData+APos)^.PreviousElementType) then
     2363          raise exception.Create('Internal structure error');
     2364    end
     2365    else
     2366      result := false;
     2367  end;
     2368end;
     2369
     2370function TBGRAPath.GoToPreviousElement(var APos: PtrInt): boolean;
     2371var lastElemType: TBGRAPathElementType;
     2372begin
     2373  if APos <= 0 then
     2374    result := false
     2375  else
     2376  begin
     2377    result := true;
     2378    if (APos = FDataPos) then
     2379      lastElemType := FLastStoredElementType
     2380    else
     2381      lastElemType := PPathElementHeader(FData+APos)^.PreviousElementType;
     2382
     2383    if lastElemType in [peOpenedSpline,peClosedSpline] then
     2384      dec(APos, (PInteger(FData+APos)-1)^ *sizeof(TPointF)); //extra
     2385    dec(APos, sizeof(TPathElementHeader) + PathElementSize[lastElemType]);
     2386
     2387    if not CheckElementType(PPathElementHeader(FData+APos)^.ElementType) or
     2388      not CheckElementType(PPathElementHeader(FData+APos)^.PreviousElementType) then
     2389        raise exception.Create('Internal structure error');
     2390  end;
     2391end;
     2392
     2393function TBGRAPath.PeekNextElement(APos: PtrInt): TBGRAPathElementType;
     2394begin
     2395  if not GoToNextElement(APos) then
     2396    result := peNone
     2397  else
     2398    result := PPathElementHeader(FData+APos)^.ElementType;
     2399end;
     2400
     2401function TBGRAPath.GetElementStartCoord(APos: PtrInt): TPointF;
     2402var
     2403  elemType: TBGRAPathElementType;
     2404  elem: pointer;
     2405begin
     2406  GetElementAt(APos, elemType, elem);
     2407  case elemType of
     2408  peNone: raise exception.Create('No element');
     2409  peMoveTo: result := PPointF(elem)^;
     2410  else
     2411    begin
     2412      if not GoToPreviousElement(APos) then
     2413        raise exception.Create('No previous element')
     2414      else
     2415      begin
     2416        result := GetElementEndCoord(APos);
     2417      end;
     2418    end;
     2419  end;
     2420end;
     2421
     2422function TBGRAPath.GetElementEndCoord(APos: PtrInt): TPointF;
     2423var elemType: TBGRAPathElementType;
     2424  elem: pointer;
     2425begin
     2426  GetElementAt(APos, elemType, elem);
     2427  case elemType of
     2428  peMoveTo,peLineTo,peCloseSubPath: result := PPointF(elem)^;
     2429  peQuadraticBezierTo: result := PQuadraticBezierToElement(elem)^.Destination;
     2430  peCubicBezierTo: result := PCubicBezierToElement(elem)^.Destination;
     2431  peArc: result := ArcEndPoint(PArcElement(elem)^);
     2432  peClosedSpline: result := PPointF(PSplineElement(elem)+1)^;
     2433  peOpenedSpline: result := (PPointF(PSplineElement(elem)+1)+(PSplineElement(elem)^.NbControlPoints-1))^;
     2434  else
     2435    result := EmptyPointF;
     2436  end;
     2437end;
     2438
     2439function TBGRAPath.GetElementLength(APos: PtrInt; AAcceptedDeviation: single): Single;
     2440var elemType: TBGRAPathElementType;
     2441  elem: pointer;
     2442  pts: array of TPointF;
     2443begin
     2444  GetElementAt(APos, elemType, elem);
     2445  case elemType of
     2446  peMoveTo: result := 0;
     2447  peLineTo,peCloseSubPath: result := VectLen(PPointF(elem)^ - GetElementStartCoord(APos))*FScale;
     2448  peQuadraticBezierTo: with PQuadraticBezierToElement(elem)^ do
     2449      result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint,Destination).ComputeLength;
     2450  peCubicBezierTo: with PCubicBezierToElement(elem)^ do
     2451      result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint1,ControlPoint2,Destination).ComputeLength(AAcceptedDeviation);
     2452  peArc: begin
     2453      result := VectLen(ArcStartPoint(PArcElement(elem)^) - GetElementStartCoord(APos));
     2454      result += PolylineLen(ComputeArc(PArcElement(elem)^, 0.1/AAcceptedDeviation));
     2455    end;
     2456  peClosedSpline,peOpenedSpline:
     2457    begin
     2458      pts := GetPolygonalApprox(APos, AAcceptedDeviation, true);
     2459      result := PolylineLen(pts) + VectLen(pts[0]-GetElementStartCoord(APos));
     2460    end
     2461  else
     2462    result := 0;
     2463  end;
     2464end;
     2465
     2466procedure TBGRAPath.GetElementAt(APos: PtrInt; out
     2467  AElementType: TBGRAPathElementType; out AElement: pointer);
     2468begin
     2469  if APos >= FDataPos then
     2470  begin
     2471    AElementType := peNone;
     2472    AElement := nil;
     2473  end else
     2474  begin
     2475    AElementType:= PPathElementHeader(FData+APos)^.ElementType;
     2476    AElement := FData+(APos+sizeof(TPathElementHeader));
     2477  end;
    9792478end;
    9802479
    … …  
    9902489end;
    9912490
     2491constructor TBGRAPath.Create(const APoints: ArrayOfTPointF);
     2492begin
     2493  Init;
     2494  SetPoints(APoints);
     2495end;
     2496
     2497constructor TBGRAPath.Create(APath: IBGRAPath);
     2498begin
     2499  Init;
     2500  APath.copyTo(self);
     2501end;
     2502
    9922503destructor TBGRAPath.Destroy;
    993 begin
     2504var i: integer;
     2505begin
     2506  for I := 0 to high(FCursors) do
     2507    FCursors[i].OnPathFree;
    9942508  if Assigned(FData) then
    9952509  begin
    … …  
    10022516procedure TBGRAPath.beginPath;
    10032517begin
     2518  DoClear;
     2519end;
     2520
     2521procedure TBGRAPath.beginSubPath;
     2522begin
     2523  OnModify;
     2524  FLastSubPathElementType := peNone;
     2525  ClearLastCoord;
     2526  FSubPathStartCoord := EmptyPointF;
     2527  FExpectedTransformedControlPoint := EmptyPointF;
     2528end;
     2529
     2530procedure TBGRAPath.DoClear;
     2531begin
     2532  OnModify;
    10042533  FDataPos := 0;
     2534  BeginSubPath;
     2535end;
     2536
     2537function TBGRAPath.CheckElementType(AElementType: TBGRAPathElementType): boolean;
     2538begin
     2539  result := AElementType <= high(TBGRAPathElementType);
    10052540end;
    10062541
    10072542procedure TBGRAPath.closePath;
    1008 begin
    1009   if (FLastElementType <> peNone) and (FLastElementType <> peCloseSubPath) then
    1010   begin
    1011     StoreElementType(peCloseSubPath);
    1012     FLastCoord := FStartCoord;
     2543var
     2544  moveToType: TBGRAPathElementType;
     2545  moveToElem: pointer;
     2546begin
     2547  if (FLastSubPathElementType <> peNone) and (FLastSubPathElementType <> peCloseSubPath) then
     2548  begin
     2549    with PClosePathElement(AllocateElement(peCloseSubPath))^ do
     2550    begin
     2551      StartCoordinate := FSubPathTransformedStartCoord;
     2552      LoopDataPos := FLastMoveToDataPos;
     2553    end;
     2554    if FLastMoveToDataPos <> -1 then
     2555    begin
     2556      GetElementAt(FLastMoveToDataPos,moveToType,moveToElem);
     2557      PMoveToElement(moveToElem)^.LoopDataPos := FDataPos;
     2558      FLastMoveToDataPos:= -1;
     2559    end;
     2560    FLastCoord := FSubPathStartCoord;
     2561    FLastTransformedCoord := FSubPathTransformedStartCoord;
    10132562  end;
    10142563end;
    … …  
    10162565procedure TBGRAPath.translate(x, y: single);
    10172566begin
     2567  OnMatrixChange;
    10182568  FMatrix *= AffineMatrixTranslation(x,y);
    10192569end;
    … …  
    10212571procedure TBGRAPath.resetTransform;
    10222572begin
     2573  OnMatrixChange;
    10232574  FMatrix := AffineMatrixIdentity;
    10242575  FAngleRadCW := 0;
    … …  
    10282579procedure TBGRAPath.rotate(angleRadCW: single);
    10292580begin
     2581  OnMatrixChange;
    10302582  FMatrix *= AffineMatrixRotationRad(-angleRadCW);
    10312583  FAngleRadCW += angleRadCW;
    … …  
    10542606procedure TBGRAPath.scale(factor: single);
    10552607begin
     2608  OnMatrixChange;
    10562609  FMatrix *= AffineMatrixScale(factor,factor);
    10572610  FScale *= factor;
    … …  
    10702623procedure TBGRAPath.moveTo(const pt: TPointF);
    10712624begin
    1072   if FLastElementType <> peMoveTo then
    1073   begin
    1074     StoreElementType(peMoveTo);
    1075     StoreCoord(pt);
     2625  if FLastSubPathElementType <> peMoveTo then
     2626  begin
     2627    FLastMoveToDataPos:= FDataPos;
     2628    with PMoveToElement(AllocateElement(peMoveTo))^ do
     2629    begin
     2630      StartCoordinate := SetLastCoord(pt);
     2631      LoopDataPos := -1;
     2632    end
    10762633  end else
    1077   begin
    1078     RewindFloat;
    1079     RewindFloat;
    1080     StoreCoord(pt);
    1081   end;
    1082   FLastCoord := pt;
    1083   FStartCoord := FLastCoord;
     2634    PMoveToElement(FData+(FDataPos-Sizeof(TMoveToElement)))^.StartCoordinate := SetLastCoord(pt);
     2635  FSubPathStartCoord := FLastCoord;
     2636  FSubPathTransformedStartCoord := FLastTransformedCoord;
    10842637end;
    10852638
    10862639procedure TBGRAPath.lineTo(const pt: TPointF);
    1087 begin
    1088   if not isEmptyPointF(FLastCoord) then
    1089   begin
    1090     StoreElementType(peLineTo);
    1091     StoreCoord(pt);
    1092     FLastCoord := pt;
     2640var lastTransfCoord, newTransfCoord: TPointF;
     2641begin
     2642  if LastCoordDefined then
     2643  begin
     2644    lastTransfCoord := FLastTransformedCoord;
     2645    newTransfCoord := SetLastCoord(pt);
     2646    if newTransfCoord <> lastTransfCoord then
     2647      PPointF(AllocateElement(peLineTo))^ := newTransfCoord;
    10932648  end else
    10942649    moveTo(pt);
    10952650end;
    10962651
     2652procedure TBGRAPath.polyline(const pts: array of TPointF);
     2653var i: integer;
     2654begin
     2655  if length(pts) = 0 then exit;
     2656  NeedSpace((sizeof(TPathElementHeader)+sizeof(TPointF))*length(pts));
     2657  moveTo(pts[0]);
     2658  for i := 1 to high(pts) do lineTo(pts[i]);
     2659end;
     2660
    10972661procedure TBGRAPath.polylineTo(const pts: array of TPointF);
    10982662var i: integer;
    10992663begin
    1100   NeedSpace((sizeof(TBGRAPathElementType)+2*sizeof(single))*length(pts));
    1101   for i := 0 to high(pts) do with pts[i] do lineTo(x,y);
     2664  NeedSpace((sizeof(TPathElementHeader)+sizeof(TPointF))*length(pts));
     2665  for i := 0 to high(pts) do lineTo(pts[i]);
     2666end;
     2667
     2668procedure TBGRAPath.polygon(const pts: array of TPointF);
     2669var lastPt: integer;
     2670begin
     2671  if length(pts) = 0 then exit;
     2672  lastPt := high(pts);
     2673  while (lastPt > 1) and (pts[lastPt] = pts[0]) do dec(lastPt);
     2674  if lastPt <> high(pts) then
     2675    polyline(slice(pts,lastPt+1))
     2676  else
     2677    polyline(pts);
     2678  closePath;
    11022679end;
    11032680
    … …  
    11092686procedure TBGRAPath.quadraticCurveTo(const cp, pt: TPointF);
    11102687begin
    1111   if not isEmptyPointF(FLastCoord) then
    1112   begin
    1113     StoreElementType(peQuadraticBezierTo);
    1114     StoreCoord(cp);
    1115     StoreCoord(pt);
    1116     FLastCoord := pt;
    1117   end else
     2688  if LastCoordDefined then
     2689    QuadraticCurveFromTransformed(FMatrix*cp, pt) else
     2690  begin
    11182691    lineTo(pt);
    1119   FExpectedControlPoint := pt+(pt-cp);
     2692    FExpectedTransformedControlPoint := FMatrix*(pt+(pt-cp));
     2693  end;
    11202694end;
    11212695
    … …  
    11272701procedure TBGRAPath.bezierCurveTo(const cp1, cp2, pt: TPointF);
    11282702begin
    1129   if isEmptyPointF(FLastCoord) then moveTo(cp1);
    1130   StoreElementType(peCubicBezierTo);
    1131   StoreCoord(cp1);
    1132   StoreCoord(cp2);
    1133   StoreCoord(pt);
    1134   FLastCoord := pt;
    1135   FExpectedControlPoint := pt + (pt-cp2);
     2703  if not LastCoordDefined then moveTo(cp1);
     2704  BezierCurveFromTransformed(FMatrix*cp1, cp2, pt);
    11362705end;
    11372706
    … …  
    11422711end;
    11432712
     2713procedure TBGRAPath.bezierCurve(p1, cp1, cp2, p2: TPointF);
     2714begin
     2715  moveTo(p1);
     2716  bezierCurveTo(cp1,cp2,p2);
     2717end;
     2718
    11442719procedure TBGRAPath.smoothBezierCurveTo(cp2x, cp2y, x, y: single);
    11452720begin
    … …  
    11492724procedure TBGRAPath.smoothBezierCurveTo(const cp2, pt: TPointF);
    11502725begin
    1151   if (FLastElementType = peCubicBezierTo) and not isEmptyPointF(FExpectedControlPoint) then
    1152     bezierCurveTo(FExpectedControlPoint,cp2,pt)
    1153   else if not isEmptyPointF(FLastCoord) then
    1154     bezierCurveTo(FLastCoord,cp2,pt)
     2726  if (FLastSubPathElementType = peCubicBezierTo) and not isEmptyPointF(FExpectedTransformedControlPoint) then
     2727    BezierCurveFromTransformed(FExpectedTransformedControlPoint,cp2,pt)
     2728  else if LastCoordDefined then
     2729    BezierCurveFromTransformed(FLastTransformedCoord,cp2,pt)
    11552730  else
    11562731    bezierCurveTo(cp2,cp2,pt);
    … …  
    11632738end;
    11642739
     2740procedure TBGRAPath.quadraticCurve(p1, cp, p2: TPointF);
     2741begin
     2742  moveTo(p1);
     2743  quadraticCurveTo(cp,p2);
     2744end;
     2745
    11652746procedure TBGRAPath.smoothQuadraticCurveTo(x, y: single);
    11662747begin
    … …  
    11702751procedure TBGRAPath.smoothQuadraticCurveTo(const pt: TPointF);
    11712752begin
    1172   if (FLastElementType = peQuadraticBezierTo) and not isEmptyPointF(FExpectedControlPoint) then
    1173     quadraticCurveTo(FExpectedControlPoint,pt)
    1174   else if not isEmptyPointF(FLastCoord) then
    1175     quadraticCurveTo(FLastCoord,pt)
     2753  if (FLastSubPathElementType = peQuadraticBezierTo) and not isEmptyPointF(FExpectedTransformedControlPoint) then
     2754    QuadraticCurveFromTransformed(FExpectedTransformedControlPoint,pt)
     2755  else if LastCoordDefined then
     2756    QuadraticCurveFromTransformed(FLastTransformedCoord,pt)
    11762757  else
    11772758    quadraticCurveTo(pt,pt);
    … …  
    12372818var p0 : TPointF;
    12382819begin
    1239   if isEmptyPointF(FLastCoord) then
     2820  if IsEmptyPointF(FLastCoord) then
    12402821    p0 := p1 else p0 := FLastCoord;
    12412822  arc(Html5ArcTo(p0,p1,p2,radius));
    … …  
    12432824
    12442825procedure TBGRAPath.arc(const arcDef: TArcDef);
    1245 var transformedArc: TArcDef;
     2826var transformedArc: TArcElement;
    12462827begin
    12472828  if (arcDef.radius.x = 0) and (arcDef.radius.y = 0) then
    … …  
    12492830  else
    12502831  begin
    1251     if isEmptyPointF(FLastCoord) then
     2832    if not LastCoordDefined then
    12522833      moveTo(ArcStartPoint(arcDef));
    1253     StoreElementType(peArc);
    1254     NeedSpace(sizeof(TArcDef));
    12552834    transformedArc.anticlockwise := arcDef.anticlockwise;
    12562835    transformedArc.startAngleRadCW := arcDef.startAngleRadCW;
    … …  
    12592838    transformedArc.radius := arcDef.radius*FScale;
    12602839    transformedArc.xAngleRadCW := arcDef.xAngleRadCW+FAngleRadCW;
    1261     PArcDef(FData+FDataPos)^ := transformedArc;
    1262     inc(FDataPos, sizeof(TArcDef));
    1263     FLastCoord := ArcEndPoint(arcDef);
    1264   end;
    1265 end;
    1266 
    1267 procedure TBGRAPath.arc(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW,
     2840    PArcElement(AllocateElement(peArc))^ := transformedArc;
     2841        {$PUSH}{$OPTIMIZATION OFF}
     2842    SetLastCoord(ArcEndPoint(arcDef));
     2843        {$POP}
     2844  end;
     2845end;
     2846
     2847procedure TBGRAPath.arc(cx, cy, rx, ry: single; xAngleRadCW, startAngleRadCW,
    12682848  endAngleRadCW: single);
    12692849begin
    … …  
    12802860  anticlockwise: boolean; x, y: single);
    12812861begin
    1282   if isEmptyPointF(FLastCoord) then
     2862  if IsEmptyPointF(FLastCoord) then
    12832863    moveTo(x,y)
    12842864  else
    … …  
    12872867
    12882868procedure TBGRAPath.copyTo(dest: IBGRAPath);
    1289 var savedPos: integer;
    1290     cp1,cp2,p1: TPointF;
    1291 begin
    1292   savedPos:= FDataPos;
    1293   FDataPos := 0;
    1294   while FDataPos < savedPos do
    1295   begin
    1296     case ReadElementType of
    1297     peMoveTo: dest.moveTo(ReadCoord);
    1298     peLineTo: dest.lineTo(ReadCoord);
    1299     peCloseSubPath: dest.closePath;
    1300     peQuadraticBezierTo:
    1301       begin
    1302         cp1 := ReadCoord;
    1303         p1 := ReadCoord;
    1304         dest.quadraticCurveTo(cp1,p1);
    1305       end;
    1306     peCubicBezierTo:
    1307       begin
    1308         cp1 := ReadCoord;
    1309         cp2 := ReadCoord;
    1310         p1 := ReadCoord;
    1311         dest.bezierCurveTo(cp1,cp2,p1);
    1312       end;
    1313     peArc: dest.arc(ReadArcDef);
    1314     end;
    1315   end;
    1316   FDataPos := savedPos;
     2869var pos: IntPtr;
     2870    elemType: TBGRAPathElementType;
     2871    elem: Pointer;
     2872    pts: array of TPointF;
     2873begin
     2874  pos := 0;
     2875  repeat
     2876    GetElementAt(pos, elemType, elem);
     2877    if elem = nil then break;
     2878    case elemType of
     2879      peMoveTo: dest.moveTo(PPointF(elem)^);
     2880      peLineTo: dest.lineTo(PPointF(elem)^);
     2881      peCloseSubPath: dest.closePath;
     2882      peQuadraticBezierTo:
     2883        with PQuadraticBezierToElement(elem)^ do
     2884          dest.quadraticCurveTo(ControlPoint,Destination);
     2885      peCubicBezierTo:
     2886        with PCubicBezierToElement(elem)^ do
     2887          dest.bezierCurveTo(ControlPoint1,ControlPoint2,Destination);
     2888      peArc: dest.arc(PArcElement(elem)^);
     2889      peOpenedSpline, peClosedSpline:
     2890        begin
     2891          with PSplineElement(elem)^ do
     2892          begin
     2893            setlength(pts, NbControlPoints);
     2894            move(Pointer(PSplineElement(elem)+1)^, pts[0], NbControlPoints*sizeof(TPointF));
     2895            if elemType = peOpenedSpline then
     2896              dest.openedSpline(pts, SplineStyle)
     2897            else
     2898              dest.closedSpline(pts, SplineStyle);
     2899            pts := nil;
     2900          end;
     2901        end;
     2902    end;
     2903  until not GoToNextElement(pos);
    13172904end;
    13182905
Note: See TracChangeset for help on using the changeset viewer.