unit FMX.RS.CanvasHelper;
//=== File Prolog ============================================================
//    This code was developed by RiverSoftAVG.
//
//--- Notes ------------------------------------------------------------------
//
//--- Development History  ---------------------------------------------------
//
//      12/2015 T. Grubb
//              - Added TRSStrokeHelper helper class to add Width property to
//                TRSStroke (TStrokeBrush)
//      11/2015 T. Grubb
//              - Changed behavior of TFMXCanvasHelper.DrawFocusRect method to
//                mimic VCL behavior by always drawing the focus rect, even
//                when Stroke.Kind = bkNone
//      12/2014 T. Grubb
//              - Fixed bug in TFMXCanvasHelper.RoundRect method
//      04/2014 T. Grubb
//              - Updated code for XE6
//      09/2013 T. Grubb
//              - Updated Uses to include FMX.Graphics for XE5+ compatibility
//              - Modified TMatrix code for XE5+ compatibility
//              - Changed TFMXCanvasHelper.Pen property from TBrush to TRSStroke
//                for XE3+
//              - Improved speed of TFMXCanvasHelper.Polyline method for
//                OPACITY = 1.  Otherwise, falls back to FMX DrawPolygon method :(
//      08/2013 T. Grubb
//              - Improved speed of TFMXCanvasHelper.Polyline method
//      09/2012 T. Grubb
//              - Changed TRSStroke to descend from TStrokeBrush in XE3+
//              - Changed TRSStroke.StrokeXXX properties to TRSStroke.XXX to
//                match the XE3 TStrokeBrush class
//              - Removed Canvas parameter from TRSStroke constructor and
//                code that uses Canvas
//      04/2012 T. Grubb
//              - Fixed bug in TFMXCanvasHelper.FillText method for drawing with angles
//              - Added default values for TRSStroke.StrokeCap, StrokeDash, and
//                StrokeJoin properties so that they will not always be streamed out
//              - Fixed TFMXCanvasHelper.RoundRect method for flipped rectangles
//      03/2012 T. Grubb
//              Initial version.
//
//      File Contents:
//           TRSStroke         VCL TPen-like class and includes StrokeXXX properties
//           TFMXCanvasHelper  Adds VCL TCanvas functions to FMX TCanvas class
//
//
//--- Warning ----------------------------------------------------------------
//  This software is property of RiverSoftAVG. Unauthorized use or
//  duplication of this software is strictly prohibited. Authorized users
//  are subject to the following restrictions:
//  * RiverSoftAVG is not responsible for
//    any consequence of the use of this software.
//  * The origin of this software must not be misrepresented either by
//    explicit claim or by omission.
//  * Altered versions of this software must be plainly marked as such.
//  * This notice may not be removed or altered.
//
//      © 2012-2015, Thomas G. Grubb
//
//=== End File Prolog ========================================================

interface

{$INCLUDE RSDefines.inc}
{$IFDEF DELPHI20PLUS}
  {$DEFINE DROPENUMPREFIX}
{$ENDIF}

uses
  SysUtils, Types, Classes, UITypes,
{$IFDEF DELPHI20PLUS}
  System.Math.Vectors,
{$ENDIF}
  {$IFDEF DELPHI19PLUS}FMX.Graphics,{$ENDIF}
  FMX.Types;

type

{$IFDEF DELPHI17PLUS}
  TRSStroke = TStrokeBrush;
{$ELSE}
  TRSStroke = class(TBrush)
  { Purpose: To provide a class that more closely approximates a TPen and which
    include StrokeXXX properties }
  private
    { private declarations }
    FStrokeJoin: TStrokeJoin;
    FStrokeThickness: Single;
    FStrokeCap: TStrokeCap;
    FStrokeDash: TStrokeDash;
    procedure SetStrokeCap(const Value: TStrokeCap);
    procedure SetStrokeDash(const Value: TStrokeDash);
    procedure SetStrokeJoin(const Value: TStrokeJoin);
    procedure SetStrokeThickness(const Value: Single);
  protected
    { protected declarations }
  public
    { public declarations }
    procedure Assign(Source: TPersistent); override;
    constructor Create(const ADefaultKind: TBrushKind; const ADefaultColor: TAlphaColor); overload;
  published
    { published declarations }
    property Thickness: Single read FStrokeThickness write SetStrokeThickness;
    property Cap: TStrokeCap read FStrokeCap write SetStrokeCap default TStrokeCap.scFlat;
    property Dash: TStrokeDash read FStrokeDash write SetStrokeDash default TStrokeDash.sdSolid;
    property Join: TStrokeJoin read FStrokeJoin write SetStrokeJoin default TStrokeJoin.sjMiter;
  end;
{$ENDIF}

  TRSStrokeHelper = class helper for TRSStroke
  private
    function GetWidth: Integer;
    procedure SetWidth(const Value: Integer);
  published
    { published declarations }
    property Width: Integer read GetWidth write SetWidth;
  end;

  TRSCanvasSavePart = (cspFill, cspStrokeFill, cspFont, cspStrokeProps, cspMatrix);
  TRSCanvasSaveParts = set of TRSCanvasSavePart;
const
  AllParts = [cspFill, cspStrokeFill, cspFont, cspStrokeProps, cspMatrix];
type
  TRSCanvasSaveState = class(TPersistent)
  { Purpose: To define a FMX canvas save state of some or all of the parts of
    an FMX TCanvas }
  private
   { private declarations }
   FMatrix: TMatrix;
   FFill, FStroke: TBrush;
   FStrokeThickness: Single;
   FStrokeCap: TStrokeCap;
   FStrokeJoin: TStrokeJoin;
   FStrokeDash: TStrokeDash;
   FFont: TFont;
   FParts: TRSCanvasSaveParts;
  protected
   { protected declarations }
   procedure AssignTo(Dest: TPersistent); override;
  public
   { public declarations }
   constructor Create( Parts: TRSCanvasSaveParts );
   destructor Destroy; override;
   procedure Assign(Source: TPersistent); override;
  published
   { published declarations }
  end; { TRSCanvasSaveState }

  TFMXCanvasHelper = class helper for TCanvas
  { Purpose: To provide Vcl-specific method signatures to FMX TCanvas
    Limitations:
      - LineTo and MoveTo do not work (use DrawLine)
      - Styles are different (Pen and Brush)
  }
  private
    function GetBrush: TBrush;
    function GetPen: {$IFDEF DELPHI17PLUS}TRSStroke{$ELSE}TBrush{$ENDIF};
    procedure SetBrush(const Value: TBrush);
    procedure SetPen(const Value: {$IFDEF DELPHI17PLUS}TRSStroke{$ELSE}TBrush{$ENDIF});
    function GetClipRect: TRect;
    function GetPenWidth: Single;
    procedure SetPenWidth(const Value: Single);
    function GetClipRectF: TRectF;
  public
    procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer; const Opacity: Single = 1); overload;
    procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Single; const Opacity: Single = 1); overload;
    procedure ArcTo(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer; const Opacity: Single = 1); overload;
    procedure ArcTo(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Single; const Opacity: Single = 1); overload;
    procedure AngleArc(X, Y: Integer; Radius: Cardinal; StartAngle, SweepAngle: Single;
      const Opacity: Single = 1); overload;
    procedure AngleArc(X, Y: Single; Radius: Single; StartAngle, SweepAngle: Single;
      const Opacity: Single = 1); overload;
    procedure BrushCopy(const Dest: TRect; Bitmap: TBitmap;
      const Source: TRect; Color: TAlphaColor; const Opacity: Single = 1); overload;
    procedure BrushCopy(const Dest: TRectF; Bitmap: TBitmap;
      const Source: TRectF; Color: TAlphaColor; const Opacity: Single = 1); overload;
    procedure Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer; const Opacity: Single = 1); overload;
    procedure Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Single; const Opacity: Single = 1); overload;
    procedure CopyRect(const Dest: TRect; Canvas: TCanvas;
      const Source: TRect); overload;
    procedure CopyRect(const Dest: TRectF; Canvas: TCanvas;
      const Source: TRectF); overload;
    // changed signature from TGraphic to TBitmap
    procedure Draw(X, Y: Integer; Bitmap: TBitmap; const Opacity: Single = 1); overload;
    // changed signature from TGraphic to TBitmap
    procedure Draw(X, Y: Single; Bitmap: TBitmap; const Opacity: Single = 1); overload;
    /// Opacity is real from 0 (transparent) to 1 (solid)
    procedure DrawLine( Pt1, Pt2: TPointF ); overload;
    procedure DrawLine( Pt1, Pt2: TPoint; const Opacity: Single = 1 ); overload;
    procedure DrawFocusRect(const Rect: TRect; const Opacity: Single = 1); overload;
    procedure DrawFocusRect(const Rect: TRectF; const Opacity: Single = 1); overload;
    procedure Ellipse(X1, Y1, X2, Y2: Integer; const Opacity: Single = 1); overload;
    procedure Ellipse(X1, Y1, X2, Y2: Single; const Opacity: Single = 1); overload;
    procedure Ellipse(const Rect: TRect; const Opacity: Single = 1); overload;
    procedure Ellipse(const Rect: TRectF; const Opacity: Single = 1); overload;
    procedure FillRect(const Rect: TRect; const Opacity: Single = 1); overload;
    procedure FillRect(const Rect: TRectF; const Opacity: Single = 1); overload;
//    procedure FloodFill(X, Y: Integer; Color: TColor; FillStyle: TFillStyle);
    procedure FrameRect(const Rect: TRect; const Opacity: Single = 1); overload;
    procedure FrameRect(const Rect: TRectF; const Opacity: Single = 1); overload;

    procedure LineTo(X, Y: Integer);
    procedure MoveTo(X, Y: Integer);
    procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer; const Opacity: Single = 1); overload;
    procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Single; const Opacity: Single = 1); overload;
    procedure Polygon(const Points: array of TPoint; const Opacity: Single = 1); overload;
    procedure Polygon(const Points: array of TPointF; const Opacity: Single = 1); overload;
    procedure Polyline(const Points: array of TPoint; const Opacity: Single = 1); overload;
    procedure Polyline(const Points: array of TPointF; const Opacity: Single = 1); overload;
    procedure PolyBezier(const Points: array of TPoint; const Opacity: Single = 1); overload;
    procedure PolyBezier(const Points: array of TPointF; const Opacity: Single = 1); overload;
    procedure PolyBezierTo(const Points: array of TPoint; const Opacity: Single = 1); overload;
    procedure PolyBezierTo(const Points: array of TPointF; const Opacity: Single = 1); overload;
    procedure Rectangle(X1, Y1, X2, Y2: Integer; const Opacity: Single = 1); overload;
    procedure Rectangle(X1, Y1, X2, Y2: Single; const Opacity: Single = 1); overload;
    procedure Rectangle(const Rect: TRect; const Opacity: Single = 1); overload;
    procedure Rectangle(const Rect: TRectF; const Opacity: Single = 1); overload;
    procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer; const Opacity: Single = 1); overload;
    procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Single; const Opacity: Single = 1); overload;
    procedure RoundRect(const Rect: TRect; CX, CY: Integer; const Opacity: Single = 1); overload;
    procedure RoundRect(const Rect: TRectF; CX, CY: Single; const Opacity: Single = 1); overload;
    // changed signature from TGraphic to TBitmap
    procedure StretchDraw(const Rect: TRect; Bitmap: TBitmap; const Opacity: Single = 1); overload;
    procedure StretchDraw(const Rect: TRectF; Bitmap: TBitmap; const Opacity: Single = 1); overload;
    function TextExtent(const Text: string): TSize;
    procedure FillText(ARect: TRectF; const AText: String; const WordWrap: Boolean; const AOpacity: Single;
      const Flags: TFillTextFlags; const Angle: Single;
      const ATextAlign: TTextAlign;
      const AVTextAlign: TTextAlign = TTextAlign.{$IFDEF DELPHI20PLUS}Center{$ELSE}taCenter{$ENDIF}); overload;
    procedure TextOut(X, Y: Integer; const Text: string; const Opacity: Single = 1); overload;
    procedure TextOut(X, Y: Single; const Text: string; const Opacity: Single = 1); overload;
    procedure TextRect(Rect: TRect; X, Y: Integer; const Text: string); overload;
    procedure TextRect(Rect: TRectF; X, Y: Single; const Text: string); overload;
    function SaveState( Parts: TRSCanvasSaveParts ): TRSCanvasSaveState; overload;
    procedure RestoreState(State: TRSCanvasSaveState; Free: Boolean = True); overload;
    /// not really a cliprect, more of a boundsrect
    property ClipRect: TRect read GetClipRect;
    property ClipRectF: TRectF read GetClipRectF;
    /// exposes Fill as Brush
    property Brush: TBrush read GetBrush write SetBrush;
    /// exposes Stroke as Pen
    property Pen: {$IFDEF DELPHI17PLUS}TRSStroke{$ELSE}TBrush{$ENDIF} read GetPen write SetPen;
    property PenWidth: Single read GetPenWidth write SetPenWidth;
  end;

{ Path stuff }
function PointsToPath( const Points: Array of TPoint; Closed: Boolean = False; Smooth: Boolean = False ): TPathData; overload;
function PointsToPath( const Points: Array of TPointF; Closed: Boolean = False; Smooth: Boolean = False ): TPathData; overload;

implementation

uses
  Math;

function FixRect( const ARect: TRectF ): TRectF; overload;
begin
     result := ARect;
     if ARect.Bottom < ARect.Top then
     begin
          result.Top := ARect.Bottom;
          result.Bottom := ARect.Top;
     end;
     if ARect.Right < ARect.Left then
     begin
          result.Left := ARect.Right;
          result.Right := ARect.Left;
     end;
end;

{ TFMXCanvasHelper }

procedure TFMXCanvasHelper.AngleArc(X, Y: Integer; Radius: Cardinal; StartAngle,
  SweepAngle: Single; const Opacity: Single);
begin
  // unlike implied by Mitov's CodeRage talk, it is not StartAngle-180
  DrawArc( PointF(X,Y), PointF(Radius, Radius), StartAngle+90, SweepAngle, Opacity );
end;

procedure TFMXCanvasHelper.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer; const Opacity: Single);
begin
  Arc( X1*1.0, Y1, X2, Y2, X3, Y3, X4, Y4, Opacity );
end;

procedure TFMXCanvasHelper.AngleArc(X, Y, Radius, StartAngle,
  SweepAngle: Single; const Opacity: Single);
begin
  // unlike implied by Mitov's CodeRage talk, it is not StartAngle-180
  DrawArc( PointF(X,Y), PointF(Radius, Radius), StartAngle+90, SweepAngle, Opacity );
end;

procedure TFMXCanvasHelper.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Single; const Opacity: Single);
begin
{TODO:   raise Exception.Create(ENotImplemented);}
end;

procedure TFMXCanvasHelper.ArcTo(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Single; const Opacity: Single);
begin
{TODO:   raise Exception.Create(ENotImplemented);}
end;

procedure TFMXCanvasHelper.ArcTo(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer; const Opacity: Single);
begin
  ArcTo( X1*1.0, Y1, X2, Y2, X3, Y3, X4, Y4, Opacity );
end;

procedure TFMXCanvasHelper.BrushCopy(const Dest: TRect; Bitmap: TBitmap;
  const Source: TRect; Color: TAlphaColor; const Opacity: Single);
begin
  BrushCopy( RectF(Dest.Left, Dest.Top, Dest.Right, Dest.Bottom),
             Bitmap,
             RectF(Source.Left, Source.Top, Source.Right, Source.Bottom),
             Color, Opacity );
end;

procedure TFMXCanvasHelper.BrushCopy(const Dest: TRectF; Bitmap: TBitmap;
  const Source: TRectF; Color: TAlphaColor; const Opacity: Single);
begin
{TODO: Fix?}
  // not an exact duplicate as DrawBitmap doesn't "flip" the bitmap if the Rect
  // is "backward"
  DrawBitmap( Bitmap,
              Source,
              Dest, Opacity);
end;

procedure TFMXCanvasHelper.Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer; const Opacity: Single);
begin
  Chord(X1*1.0, Y1, X2, Y2, X3, Y3, X4, Y4, Opacity);
end;

procedure TFMXCanvasHelper.Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Single; const Opacity: Single);
begin
{TODO:   raise Exception.Create(ENotImplemented);}
end;

procedure TFMXCanvasHelper.CopyRect(const Dest: TRectF; Canvas: TCanvas;
  const Source: TRectF);
begin
{TODO:   raise Exception.Create(ENotImplemented);}
end;

procedure TFMXCanvasHelper.CopyRect(const Dest: TRect; Canvas: TCanvas;
  const Source: TRect);
begin
  CopyRect( RectF(Dest.Left, Dest.Top, Dest.Right, Dest.Bottom),
            Canvas,
            RectF(Source.Left, Source.Top, Source.Right, Source.Bottom) );
end;

procedure TFMXCanvasHelper.Draw(X, Y: Integer; Bitmap: TBitmap; const Opacity: Single);
begin
  DrawBitmap( Bitmap,
              RectF(0, 0, Width-X, Height-Y),
              RectF(X, Y, Width, Height), Opacity);
end;

procedure TFMXCanvasHelper.Draw(X, Y: Single; Bitmap: TBitmap; const Opacity: Single);
begin
  DrawBitmap( Bitmap,
              RectF(0, 0, Width-X, Height-Y),
              RectF(X, Y, Width, Height), Opacity);
end;

procedure TFMXCanvasHelper.DrawFocusRect(const Rect: TRectF; const Opacity: Single);
var
  State: TRSCanvasSaveState;
begin
  State := SaveState(AllParts);
  try
    StrokeThickness := 1;
    StrokeDash := TStrokeDash.{$IFDEF DELPHI20PLUS}Dash{$ELSE}sdDash{$ENDIF};
    Stroke.Kind := TBrushKind.{$IFDEF DROPENUMPREFIX}Solid{$ELSE}bkSolid{$ENDIF};
    FrameRect(Rect, Opacity);
  finally
    RestoreState(State);
  end;
end;

procedure TFMXCanvasHelper.DrawFocusRect(const Rect: TRect; const Opacity: Single);
begin
  DrawFocusRect( RectF(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom), Opacity );
end;

procedure TFMXCanvasHelper.DrawLine( Pt1, Pt2: TPointF );
begin
  DrawLine( Pt1, Pt2, 1 );
end;

procedure TFMXCanvasHelper.DrawLine( Pt1, Pt2: TPoint; const Opacity: Single);
begin
  DrawLine( PointF(Pt1.X, Pt1.Y), PointF(Pt2.X, Pt2.Y), Opacity );
end;

procedure TFMXCanvasHelper.Ellipse(const Rect: TRect; const Opacity: Single = 1);
begin
  Ellipse(RectF(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom), Opacity);
end;

procedure TFMXCanvasHelper.Ellipse(const Rect: TRectF; const Opacity: Single);
begin
  DrawEllipse(Rect,Opacity);
  FillEllipse(Rect,Opacity);
end;

procedure TFMXCanvasHelper.Ellipse(X1, Y1, X2, Y2: Single; const Opacity: Single = 1);
begin
  Ellipse(RectF(X1,Y1,X2,Y2),Opacity);
end;

procedure TFMXCanvasHelper.Ellipse(X1, Y1, X2, Y2: Integer; const Opacity: Single = 1);
begin
  Ellipse(RectF(X1,Y1,X2,Y2),Opacity);
end;

procedure TFMXCanvasHelper.FillRect(const Rect: TRect; const Opacity: Single);
begin
  FillRect(RectF(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom), 0, 0, [], Opacity);
end;

procedure TFMXCanvasHelper.FillRect(const Rect: TRectF; const Opacity: Single);
begin
  FillRect(Rect, 0, 0, [], Opacity);
end;

procedure TFMXCanvasHelper.FillText(ARect: TRectF; const AText: String;
  const WordWrap: Boolean; const AOpacity: Single; const Flags: TFillTextFlags;
  const Angle: Single;
  const ATextAlign, AVTextAlign: TTextAlign);
var
  State: TMatrix;
  M: TMatrix;
  CenterPt: TPointF;
begin
  ARect := FixRect(ARect);
  if Angle = 0 then
  begin
    FillText(ARect, AText, WordWrap, AOpacity, Flags, ATextAlign, AVTextAlign );
    Exit;
  end;
  // Save old transformation matrix
  State := Matrix;
  try
    // need to translate the rotation point to 0,0 and back.  Figure out
    // translation caused by ARect and by the current matrix (m31=x, m32=y)
    with ARect do
    begin
      CenterPt.X := (Right - Left) / 2 + Left + Matrix.m31;
      CenterPt.Y := (Bottom - Top) / 2 + Top + Matrix.m32;
    end;
    M := Matrix;
{TODO: Right now, flipping angle, not sure if should be done here or by caller}
{$IFDEF DELPHI19PLUS}
    M := M * TMatrix.CreateTranslation(-CenterPt.X,-CenterPt.Y);
    M := M * TMatrix.CreateRotation(DegToRad(-Angle));
    M := M * TMatrix.CreateTranslation(CenterPt.X,CenterPt.Y);
{$ELSE}
    M := MatrixMultiply(M, CreateTranslateMatrix(-CenterPt.X,-CenterPt.Y));
    M := MatrixMultiply(M, CreateRotationMatrix(DegToRad(-Angle)));
    M := MatrixMultiply(M, CreateTranslateMatrix(CenterPt.X,CenterPt.Y));
{$ENDIF}
    SetMatrix(M);
    FillText( ARect, AText, WordWrap, AOpacity, Flags, ATextAlign, AVTextAlign );
  finally
    SetMatrix( State );
  end;
end;

procedure TFMXCanvasHelper.FrameRect(const Rect: TRectF; const Opacity: Single);
begin
  DrawRect(Rect, 0, 0, [], Opacity);
end;

procedure TFMXCanvasHelper.FrameRect(const Rect: TRect; const Opacity: Single);
begin
  FrameRect(RectF(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom), Opacity);
end;

function TFMXCanvasHelper.GetBrush: TBrush;
begin
  result := Fill;
end;

function TFMXCanvasHelper.GetClipRect: TRect;
begin
  result := Rect(0,0,Width,Height);
end;

function TFMXCanvasHelper.GetClipRectF: TRectF;
begin
  result := RectF(0,0,Width,Height);
end;

function TFMXCanvasHelper.GetPen: {$IFDEF DELPHI17PLUS}TRSStroke{$ELSE}TBrush{$ENDIF};
begin
  result := Stroke;
end;

function TFMXCanvasHelper.GetPenWidth: Single;
begin
  result := StrokeThickness;
end;

procedure TFMXCanvasHelper.LineTo(X, Y: Integer);
begin
end;

procedure TFMXCanvasHelper.MoveTo(X, Y: Integer);
begin
end;

procedure TFMXCanvasHelper.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer; const Opacity: Single);
begin
  Pie(X1*1.0, Y1, X2, Y2, X3, Y3, X4, Y4, Opacity);
end;

procedure TFMXCanvasHelper.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Single; const Opacity: Single);
begin
{TODO:   raise Exception.Create(ENotImplemented);}
end;

procedure TFMXCanvasHelper.PolyBezier(const Points: array of TPoint; const Opacity: Single);
var
  Path: TPathData;
begin
  Path := PointsToPath(Points, False, True);
  try
    DrawPath(Path,Opacity);
  finally
    Path.Free;
  end;
end;

procedure TFMXCanvasHelper.PolyBezier(const Points: array of TPointF; const Opacity: Single);
var
  Path: TPathData;
begin
  Path := PointsToPath(Points, False, True);
  try
    DrawPath(Path,Opacity);
  finally
    Path.Free;
  end;
end;

procedure TFMXCanvasHelper.PolyBezierTo(const Points: array of TPointF; const Opacity: Single);
var
  Path: TPathData;
begin
  Path := PointsToPath(Points, True, True);
  try
    DrawPath(Path,Opacity);
  finally
    Path.Free;
  end;
end;

procedure TFMXCanvasHelper.PolyBezierTo(const Points: array of TPoint; const Opacity: Single);
var
  Path: TPathData;
begin
  Path := PointsToPath(Points, True, True);
  try
    DrawPath(Path,Opacity);
  finally
    Path.Free;
  end;
end;

procedure TFMXCanvasHelper.Polygon(const Points: array of TPointF; const Opacity: Single = 1);
var
  Path: TPathData;
begin
  Path := PointsToPath(Points, True, False);
  try
    DrawPath(Path,Opacity);
    FillPath(Path,Opacity);
  finally
    Path.Free;
  end;
end;

procedure TFMXCanvasHelper.Polygon(const Points: array of TPoint; const Opacity: Single = 1);
var
  Path: TPathData;
begin
  Path := PointsToPath(Points, True, False);
  try
    DrawPath(Path,Opacity);
    FillPath(Path,Opacity);
  finally
    Path.Free;
  end;
end;

procedure TFMXCanvasHelper.Polyline(const Points: array of TPoint; const Opacity: Single);
//var
//  Polygon: TPolygon;
//begin
//  SetLength(Polygon, Length(Points));
//  System.Move(Points[0], Polygon[0], Length(Points) * SizeOf(TPoint));
//  DrawPolygon(Polygon, Opacity);
var
  Pt: TPoint;
  i: Integer;
begin
  if Length(Points) < 2 then Exit;

  Pt := Points[0];
  for i := 1 to Length(Points)-1 do
  begin
    DrawLine( Pt, Points[i], Opacity );
    Pt := Points[i];
  end;
//  Path := PointsToPath(Points, False, False);
//  try
//    DrawPath(Path,Opacity);
//  finally
//    Path.Free;
//  end;
end;

procedure TFMXCanvasHelper.Polyline(const Points: array of TPointF; const Opacity: Single);
var
  Polygon: TPolygon;
  Pt: TPointF;
  i: Integer;
begin
  if Length(Points) < 2 then Exit;
  if Opacity < 1 then
  begin
    SetLength(Polygon, Length(Points));
    System.Move(Points[0], Polygon[0], Length(Points) * SizeOf(TPoint));
    DrawPolygon(Polygon, Opacity);
  end
  else
  begin
    Pt := Points[0];
    for i := 1 to Length(Points)-1 do
    begin
      DrawLine( Pt, Points[i], Opacity );
      Pt := Points[i];
    end;
  end;
end;

procedure TFMXCanvasHelper.Rectangle(X1, Y1, X2, Y2: Integer; const Opacity: Single);
begin
  Rectangle(RectF( X1, Y1, X2, Y2 ), Opacity);
end;

procedure TFMXCanvasHelper.Rectangle(X1, Y1, X2, Y2: Single; const Opacity: Single);
begin
  Rectangle(RectF( X1, Y1, X2, Y2 ), Opacity);
end;

procedure TFMXCanvasHelper.RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer; const Opacity: Single);
begin
  RoundRect(X1*1.0, Y1, X2, Y2, X3, Y3, Opacity);
end;

procedure TFMXCanvasHelper.Rectangle(const Rect: TRect; const Opacity: Single);
begin
  Rectangle( RectF(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom), Opacity );
end;

procedure TFMXCanvasHelper.Rectangle(const Rect: TRectF; const Opacity: Single);
begin
  DrawRect(Rect, 0, 0, [], Opacity);
  FillRect(Rect, 0, 0, [], Opacity);
end;

procedure TFMXCanvasHelper.RestoreState(State: TRSCanvasSaveState;
  Free: Boolean);
begin
  State.AssignTo(Self);
  if Free then
    State.Free;
end;

procedure TFMXCanvasHelper.RoundRect(const Rect: TRectF; CX, CY: Single; const Opacity: Single);
var
  Path: TPathData;
begin
  if (RectWidth(Rect) = 0) or (RectHeight(Rect) = 0) then Exit;
  Path := TPathData.Create;
  try
    Path.AddRectangle(Rect, CX, CY, AllCorners, TCornerType.{$IFDEF DROPENUMPREFIX}Round{$ELSE}ctRound{$ENDIF});
    FillPath(Path, Opacity);
    DrawPath(Path, Opacity);
  finally
    Path.Free;
  end;
end;

procedure TFMXCanvasHelper.RoundRect(const Rect: TRect; CX, CY: Integer; const Opacity: Single);
begin
  RoundRect(RectF(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom), CX, CY, Opacity);
end;

procedure TFMXCanvasHelper.RoundRect(X1, Y1, X2, Y2, X3, Y3: Single; const Opacity: Single);
begin
  RoundRect(RectF( X1, Y1, X2, Y2 ), X3, Y3, Opacity);
end;

function TFMXCanvasHelper.SaveState(
  Parts: TRSCanvasSaveParts): TRSCanvasSaveState;
begin
  // this routine replaces the SaveState which is buggy as of XE2 Upd 4
  result := TRSCanvasSaveState.Create(Parts);
  result.Assign(Self);
end;

procedure TFMXCanvasHelper.SetBrush(const Value: TBrush);
begin
  Fill := Value;
end;

procedure TFMXCanvasHelper.SetPen(const Value: {$IFDEF DELPHI17PLUS}TRSStroke{$ELSE}TBrush{$ENDIF});
begin
  Stroke.Assign(Value);
end;

procedure TFMXCanvasHelper.SetPenWidth(const Value: Single);
begin
  StrokeThickness := Value;
end;

procedure TFMXCanvasHelper.StretchDraw(const Rect: TRectF; Bitmap: TBitmap; const Opacity: Single);
begin
  DrawBitmap( Bitmap,
              RectF(0,0,Bitmap.Width,Bitmap.Height),
              Rect, Opacity);
end;

procedure TFMXCanvasHelper.StretchDraw(const Rect: TRect; Bitmap: TBitmap; const Opacity: Single);
begin
  DrawBitmap( Bitmap,
              RectF(0,0,Bitmap.Width,Bitmap.Height),
              RectF(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom), Opacity);
end;

function TFMXCanvasHelper.TextExtent(const Text: string): TSize;
begin
  if Text = '' then
  begin
    result.cx := 0;
    result.cy := 0;
  end
  else
  begin
    result.cx := Round(TextWidth(Text));
    result.cy := Round(TextHeight(Text));
  end;
end;

procedure TFMXCanvasHelper.TextOut(X, Y: Integer; const Text: String; const Opacity: Single);
begin
  FillText(RectF(X,Y,X+TextWidth(Text),Y+TextHeight(Text)), Text, False, Opacity, [], TTextAlign.{$IFDEF DELPHI20PLUS}Leading{$ELSE}taLeading{$ENDIF});
end;

procedure TFMXCanvasHelper.TextOut(X, Y: Single; const Text: String; const Opacity: Single);
var
  R: TRectF;
begin
  R := RectF(X,Y,X+TextWidth(Text),Y+TextHeight(Text));
  FillText(R, Text, False, Opacity, [], TTextAlign.{$IFDEF DELPHI20PLUS}Leading{$ELSE}taLeading{$ENDIF});
end;

procedure TFMXCanvasHelper.TextRect(Rect: TRect; X, Y: Integer; const Text: string);
begin
  TextRect(RectF(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom), X, Y, Text);
end;

procedure TFMXCanvasHelper.TextRect(Rect: TRectF; X, Y: Single; const Text: string);
var
  CanvasState: {$IFDEF USE_RSCANVASSAVE}TRSCanvasSaveState{$ELSE}TCanvasSaveState{$ENDIF};
begin
  CanvasState := SaveState{$IFDEF USE_RSCANVASSAVE}(AllParts){$ELSE}{$ENDIF};
  try
    IntersectClipRect(Rect);
    FillText( RectF(X,Y,Rect.Right, Rect.Bottom), Text, False, 1, [],
      TTextAlign.{$IFDEF DELPHI20PLUS}Leading{$ELSE}taLeading{$ENDIF},
      TTextAlign.{$IFDEF DELPHI20PLUS}Leading{$ELSE}taLeading{$ENDIF} );
  finally
    RestoreState( CanvasState );
  end;
end;

function PointsToPath( const Points: Array of TPoint; Closed, Smooth: Boolean ): TPathData;
var
  i: Integer;
  NewPoints: Array of TPointF;
begin
  // create an array of TPointF
  SetLength(NewPoints, Length(Points));
  for i := 0 to Length(Points)-1 do
    NewPoints[i] := PointF(Points[i].X, Points[i].Y);
  result := PointsToPath( NewPoints, Closed, Smooth );
end;

function PointsToPath( const Points: Array of TPointF; Closed, Smooth: Boolean ): TPathData;
var
  i: Integer;
begin
  // result needs to be freed
  result := TPathData.Create;
  if Length(Points) < 2 then
    Exit;
  result.MoveTo(Points[0]);
  i := 1;
  while i < Length(Points) do
  begin
    if Smooth then
    begin
      if (i+2) < Length(Points) then
        result.CurveTo( Points[i],
                        Points[i+1],
                        Points[i+2] );
      Inc(i,3);
    end
    else
    begin
      result.LineTo(Points[i]);
      Inc(i);
    end;
  end;
  if Closed then
  begin
    if Smooth then
    begin
      Dec(i,3);
      if (i+1) < Length(Points) then
        result.CurveTo( Points[i],
                        Points[i+1],
                        Points[0] );
    end
    else
      result.LineTo(Points[0]);
  end;
end;

{$IFNDEF DELPHI17PLUS}
{ TRSStroke }

procedure TRSStroke.Assign(Source: TPersistent);
begin
  if Source is TRSStroke then
  begin
    Join := TRSStroke(Source).Join;
    Thickness := TRSStroke(Source).Thickness;
    Cap := TRSStroke(Source).Cap;
    Dash := TRSStroke(Source).Dash;
  end;
  inherited Assign(Source);
end;

constructor TRSStroke.Create(const ADefaultKind: TBrushKind;
  const ADefaultColor: TAlphaColor);
begin
  inherited Create(ADefaultKind, ADefaultColor);
  FStrokeThickness := 1;
end;

procedure TRSStroke.SetStrokeCap(const Value: TStrokeCap);
begin
  if Cap <> Value then
  begin
    FStrokeCap := Value;
    if Assigned(OnChanged) then
      OnChanged(Self);
  end;
end;

procedure TRSStroke.SetStrokeDash(const Value: TStrokeDash);
begin
  if Dash <> Value then
  begin
    FStrokeDash := Value;
    if Assigned(OnChanged) then
      OnChanged(Self);
  end;
end;

procedure TRSStroke.SetStrokeJoin(const Value: TStrokeJoin);
begin
  if Join <> Value then
  begin
    FStrokeJoin := Value;
    if Assigned(OnChanged) then
      OnChanged(Self);
  end;
end;

procedure TRSStroke.SetStrokeThickness(const Value: Single);
begin
  if Thickness <> Value then
  begin
    FStrokeThickness := Value;
    if Assigned(OnChanged) then
      OnChanged(Self);
  end;
end;
{$ENDIF}

{ TRSCanvasSaveState }

procedure TRSCanvasSaveState.Assign(Source: TPersistent);
begin
  if Source is TCanvas then
  begin
    if cspFill in FParts then
      FFill.Assign(TCanvas(Source).Fill);
    if cspStrokeFill in FParts then
      FStroke.Assign(TCanvas(Source).Stroke);
    if cspFont in FParts then
      FFont.Assign(TCanvas(Source).Font);
    if cspStrokeProps in FParts then
    begin
{$IFDEF DELPHI17PLUS}
      FStrokeThickness := TCanvas(Source).Stroke.Thickness;
      FStrokeCap := TCanvas(Source).Stroke.Cap;
      FStrokeJoin := TCanvas(Source).Stroke.Join;
      FStrokeDash := TCanvas(Source).Stroke.Dash;
{$ELSE}
      FStrokeThickness := TCanvas(Source).StrokeThickness;
      FStrokeCap := TCanvas(Source).StrokeCap;
      FStrokeJoin := TCanvas(Source).StrokeJoin;
      FStrokeDash := TCanvas(Source).StrokeDash;
{$ENDIF}
    end;
    if cspMatrix in FParts then
      FMatrix := TCanvas(Source).Matrix;
  end else
    inherited;
end;

procedure TRSCanvasSaveState.AssignTo(Dest: TPersistent);
begin
  if Dest is TCanvas then
  begin
    if cspMatrix in FParts then
      TCanvas(Dest).SetMatrix(Self.FMatrix);
    if cspFill in FParts then
      TCanvas(Dest).Fill.Assign(Self.FFill);
    if cspStrokeFill in FParts then
      TCanvas(Dest).Stroke.Assign(Self.FStroke);
    if cspFont in FParts then
      TCanvas(Dest).Font.Assign(Self.FFont);
    if cspStrokeProps in FParts then
    begin
      TCanvas(Dest).StrokeThickness := Self.FStrokeThickness;
      TCanvas(Dest).StrokeCap := Self.FStrokeCap;
      TCanvas(Dest).StrokeJoin := Self.FStrokeJoin;
      TCanvas(Dest).StrokeDash := Self.FStrokeDash;
    end;
  end else
    inherited;
end;

constructor TRSCanvasSaveState.Create(Parts: TRSCanvasSaveParts);
begin
  inherited Create;
  FParts := Parts;
  if cspFill in FParts then
    FFill := TBrush.Create(TBrushKind.{$IFDEF DELPHI20PLUS}Solid{$ELSE}bkSolid{$ENDIF}, TAlphaColors.Black);
  if cspFont in FParts then
    FFont := TFont.Create;
  if cspStrokeFill in FParts then
    FStroke := TBrush.Create(TBrushKind.{$IFDEF DELPHI20PLUS}Solid{$ELSE}bkSolid{$ENDIF}, TAlphaColors.White);
end;

destructor TRSCanvasSaveState.Destroy;
begin
  FFill.Free;
  FFont.Free;
  FStroke.Free;
  inherited Destroy;
end;

{ TRSStrokeHelper }

function TRSStrokeHelper.GetWidth: Integer;
begin
  result := Round(Thickness);
end;

procedure TRSStrokeHelper.SetWidth(const Value: Integer);
begin
  Thickness := Value;
end;

end.