{********************************************}
{ TeeChart Pro SVG Canvas and Exporting      }
{ SVG : Scalable Vector Graphics             }
{ www.w3.org/Graphics/SVG                    }
{                                            }
{ Copyright (c) 2001-2020 by Steema Software }
{       All Rights Reserved                  }
{********************************************}
unit TeeSVGCanvas;
{$I TeeDefs.inc}

interface

uses {$IFNDEF LINUX}
     {$IFNDEF FMX}
     Windows,
     {$ENDIF}
     {$ENDIF}
     Classes, SysUtils,

     {$IFDEF FMX}
     System.UITypes, FMX.Types, FMX.Forms, System.Types,

     {$IFDEF D17}
     System.UIConsts,
     {$ENDIF}

     {$IFDEF D19}
     FMX.Graphics, System.Character,
     {$ENDIF}

     {$IFDEF D22}
     FMX.Utils,
     {$ENDIF}

     {$ELSE}

     {$IFDEF D16}
     System.UITypes,
     {$ENDIF}

     Graphics, Forms, Controls, StdCtrls,
     {$IFDEF D9}
     Types,
     {$ENDIF}
     {$ENDIF}

     {$IFDEF FMX}
     FMXTee.Canvas, FMXTee.Procs, FMXTee.Editor.Export
     {$ELSE}
     TeCanvas, TeeProcs, TeeExport
     {$ENDIF}

     , Math;

type
  TSVGCanvas = class(TTeeNeutralCanvas, ICanvasHyperlinks, ICanvasToolTips)
  private
    { Private declarations }
    FX           : TCoordinate;
    FY           : TCoordinate;
    FStrings     : TStrings;

    IClipCount     : Integer;
    IClipStack     : Integer;
    IGradientCount : Integer;

    Procedure Add(Const S:String); {$IFDEF D9}inline;{$ENDIF}
    procedure AddEnd(const s:String);
    Procedure InternalRect(Const Rect:TRect; UsePen:Boolean;
                           RoundX:Integer=0; RoundY:Integer=0);
    Function PointToStr(const X,Y:TCoordinate):String;
    Procedure PrepareShape;
    Function SVGBrushPen(UsePen:Boolean=True):String;
    procedure SVGClip;
    Function SVGColor(AColor:TColor):String;
    Function SVGEllipse(const X1,Y1,X2,Y2:TCoordinate):String;
    procedure SVGEndClip;
    function SVGOpacity(IsPen:Boolean; const AColor:TColor):String;
    Function SVGPen:String;
    Function SVGPoints(const Points: Array of TPoint):String;
    Function SVGRect(Const Rect:TRect):String;
    Function TotalBounds:String;
	Procedure TextOutWithRotate({$IFDEF FMX}const{$ENDIF} X,Y:TCoordinate; const Text:String; const RotDegree:Double);
  protected
    { Protected declarations }

    function BeginEntity(const Entity:String; const Visual:TVisualBlock=nil; const Transform:TTeeTransform=nil):TVisualBlock; override;
    procedure EndEntity; override;

    // ICanvasHyperlinks
    procedure AddLink(x,y:Integer; const Text,URL,Hint:String);

    // ICanvasToolTips
    procedure AddToolTip(const Entity,ToolTip:String);

    { 2d }
    procedure SetPixel(X, Y: Integer; Value: TColor); override;

    { 3d }
    procedure SetPixel3D(X,Y,Z:Integer; Value: TColor); override;

    function HeaderContents:String; virtual;
  public
    { Public declarations }
    Antialias : Boolean;
    DocType : String;
    Groups : Boolean;
    SVGDescription : String;

    Constructor CreateText(const AStrings:TStrings);

    Function InitWindow( const DestCanvas:TCanvas;
                         const A3DOptions:TView3DOptions;
                         ABackColor:TColor;
                         Is3D:Boolean;
                         Const UserRect:TRect):TRect; override;

    class function Description:String; override;

    procedure Arc(const Left, Top, Right, Bottom, StartX, StartY, EndX, EndY: Integer); override;
    procedure Draw(X, Y: Integer; const Graphic: TGraphic); override;
    procedure FillRect(const Rect: TRect); override;
    procedure Ellipse(const X1, Y1, X2, Y2: TCoordinate); override;
    procedure LineTo(const X,Y:TCoordinate); override;
    procedure MoveTo(const X,Y:TCoordinate); override;
    procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); override;
    procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer; HolePercent: Double); overload;
    procedure Donut(XCenter,YCenter,XRadius,YRadius:Integer;
                    Const StartAngle,EndAngle,HolePercent:Double); override;
    procedure Rectangle(const X0,Y0,X1,Y1:TCoordinate); override;
    procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer); override;
    procedure StretchDraw(const Rect: TRect; const Graphic: TGraphic); override;
    Procedure TextOut({$IFDEF FMX}const{$ENDIF} X,Y:TCoordinate; const Text:String); override;

    procedure ClipEllipse(Const Rect:TRect; Inverted:Boolean=False); override;
    procedure ClipRectangle(Const Rect:TRect); override;
    Procedure ClipRectangle(Const Rect:TRect; RoundX,RoundY:Integer); override;
    Procedure ClipPolygon(const Points:Array of TPoint; NumPoints:Integer;
                          DiffRegion:Boolean=False); override;

    procedure UnClipRectangle; override;

    Procedure GradientFill( Const Rect:TRect;
                            StartColor,EndColor:TColor;
                            Direction:TGradientDirection;
                            Balance:Integer=50;
                            RadialX:Integer=0;
                            RadialY:Integer=0); override;

    procedure RotateLabel(x,y:Integer; Const St:String; RotDegree:Double;
                          AllowHTML:Boolean=False); override;
    procedure RotateLabel3D(x,y,z:Integer;
                            const St:String; RotDegree:Double;
                            AllowHTML:Boolean=False); override;
    Procedure Polygon({$IFDEF D6}const{$ENDIF} Points: array of TPoint); override;
    Procedure Polyline({$IFDEF D6}const{$ENDIF} Points:Array of TPoint); override;

    { 3d }
    Procedure ShowImage(const DestCanvas,DefaultCanvas:TCanvas; Const UserRect:TRect); override;
    Procedure TextOut3D(X,Y,Z:Integer; const Text:String; AllowHTML:Boolean=False); override;
  end;

  TSVGExportFormat=class(TTeeExportFormat)
  private
    FAntiAlias : Boolean;
    FDesc   : String;
    FGroups : Boolean;

    Procedure CheckProperties;
  protected
    FProperties : TForm;
    Procedure DoCopyToClipboard; override;
  public
    Destructor Destroy; override;

    function Description:String; override;
    function FileExtension:String; override;
    class function FileFilter:String; override;
    Function SVG:TStringList;

    {$IFDEF FMX}
    function Editor(AOwner:TComponent):TForm; override;
    {$ELSE}
    Function Options(Check:Boolean=True):TForm; override;
    {$ENDIF}

    Procedure SaveToStream(Stream:TStream); override;

    property AntiAlias:Boolean read FAntiAlias write FAntiAlias;
    property Groups:Boolean read FGroups write FGroups;
    property SVGDescription:String read FDesc write FDesc;
  end;

procedure TeeSaveToSVGFile( const APanel:TCustomTeePanel; FileName: String;
                            AWidth:Integer=0; AHeight: Integer=0);

implementation

Uses {$IFDEF FMX}
     FMX.Platform,
     {$ELSE}
     Clipbrd,
     {$ENDIF}

     {$IFDEF FMX}
     FMXTee.Constants
     {$ELSE}
     TeeConst
     {$ENDIF};

{ TSVGCanvas }

Constructor TSVGCanvas.CreateText(const AStrings:TStrings);
begin
  Create;

  SupportsID:=True;
  FSupportsAlpha:=True;

  FStrings:=AStrings;
  UseBuffer:=False;

  Antialias:=True;
  Groups:=True;

  { start }
  Add('<?xml version="1.0" standalone="no"?>');

  DocType:='<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">';
end;

Procedure TSVGCanvas.ShowImage(const DestCanvas,DefaultCanvas:TCanvas; Const UserRect:TRect);
begin { finish }
  Add('</svg>');
  Pen.OnChange:=nil;
end;

Procedure TSVGCanvas.Add(Const S:String);
begin
  FStrings.Add(S);
end;

// NOTE: rgba not supported in svg. RGB only.
// See fill-opacity, stroke-opacity and opacity (both stroke and fill)
Function TSVGCanvas.SVGColor(AColor:TColor):String;

  function InternalColor:String;
  begin
    case AColor of
    {$IFDEF FMX}claBlack{$ELSE}clBlack{$ENDIF}: result:='black';
    {$IFDEF FMX}claWhite{$ELSE}clWhite{$ENDIF}: result:='white';
    {$IFDEF FMX}claRed{$ELSE}clRed{$ENDIF}:   result:='red';
    {$IFDEF FMX}claGreen{$ELSE}clGreen{$ENDIF}: result:='green';
    {$IFDEF FMX}claBlue{$ELSE}clBlue{$ENDIF}:  result:='blue';
    {$IFDEF FMX}claYellow{$ELSE}clYellow{$ENDIF}: result:='yellow';
    {$IFDEF FMX}claGray{$ELSE}clGray{$ENDIF}:  result:='gray';
    {$IFDEF FMX}claNavy{$ELSE}clNavy{$ENDIF}:  result:='navy';
    {$IFDEF FMX}claOlive{$ELSE}clOlive{$ENDIF}: result:='olive';
    {$IFDEF FMX}claLime{$ELSE}clLime{$ENDIF}:  result:='lime';
    {$IFDEF FMX}claTeal{$ELSE}clTeal{$ENDIF}:  result:='teal';
    {$IFDEF FMX}claSilver{$ELSE}clSilver{$ENDIF}:  result:='silver';
    {$IFDEF FMX}claPurple{$ELSE}clPurple{$ENDIF}:  result:='purple';
    {$IFDEF FMX}claFuchsia{$ELSE}clFuchsia{$ENDIF}:  result:='fuchsia';
    {$IFDEF FMX}claMaroon{$ELSE}clMaroon{$ENDIF}:  result:='maroon';
    else
       result:='rgb('+TeeStr(TRGBA(AColor).Red)+','+
                      TeeStr(TRGBA(AColor).Green)+','+
                      TeeStr(TRGBA(AColor).Blue)+')';
    end;
  end;

begin
  // Removed. (Colors can now be RGBA) AColor:=ColorToRGB(AColor);
  result:='"'+InternalColor+'"';
end;

procedure TSVGCanvas.Rectangle(const X0,Y0,X1,Y1:TCoordinate);
begin
  InternalRect(TeeRect(X0,Y0,X1,Y1),True);
end;

procedure TSVGCanvas.MoveTo(const X, Y: TCoordinate);
begin
  FX:=X;
  FY:=Y;
end;

procedure TSVGCanvas.AddEnd(const s:String);
begin
  Add(s+'/>');
end;

procedure TSVGCanvas.AddLink(x, y: Integer; const Text, URL, Hint: String);
begin
  Add('<a xlink:href="'+URL+'">');
  TextAlign:=TA_LEFT;
  TextOut(X,Y,Text);
  Add('</a>');
end;

procedure TSVGCanvas.AddToolTip(const Entity, ToolTip: String);
begin
  AddEnd('<g id="'+Entity+'"');

//  'onmousemove="ShowTooltip(evt, '+ToolTip+')" onmouseout="HideTooltip(evt)"';
end;

function ToStr(const Value:TCoordinate):String; {$IFDEF D9}inline;{$ENDIF}
begin
  {$IFDEF FMX}
  result:=FormatFloat('0.###',Value,USFormatSettings);
  {$ELSE}
  result:=TeeStr(Value);
  {$ENDIF}
end;

procedure TSVGCanvas.LineTo(const X, Y: TCoordinate);
var tmpSt : String;
begin
  tmpSt:='<line x1="'+ToStr(FX)+'" y1="'+ToStr(FY)+'" '+
               'x2="'+ToStr(X)+ '" y2="'+ToStr(Y)+'" fill="none" '+SVGPen;
  AddEnd(tmpSt);
  FX:=X;
  FY:=Y;
end;

Function TSVGCanvas.SVGRect(Const Rect:TRect):String;
var tmp : TRect;
begin
  tmp:=OrientRectangle(Rect);

  with tmp do
  result:=' x="'+ToStr(Left)+'" y="'+ToStr(Top)+'" '+
          ' width="'+ToStr(Right-Left-1)+'"'+
          ' height="'+ToStr(Bottom-Top-1)+'"';
end;

procedure TSVGCanvas.SVGClip;
var ClipName : String;
begin
  Inc(IClipStack);
  Inc(IClipCount);
  ClipName:='Clip'+IntToStr(IClipCount);
  Add('<g clip-path="url(#'+ClipName+')">');
  Add('<defs>');
  Add('<clipPath id="'+ClipName+'" style="clip-rule:nonzero">');
end;

procedure TSVGCanvas.ClipRectangle(Const Rect:TRect);
begin
  SVGClip;
  AddEnd('<rect '+SVGRect(Rect));
  SVGEndClip;
end;

Function TSVGCanvas.SVGEllipse(const X1,Y1,X2,Y2:TCoordinate):String;
begin
  result:='cx="'+ToStr((X1+X2) {$IFDEF FMX}*0.5{$ELSE}div 2{$ENDIF})+
          '" cy="'+ToStr((Y1+Y2) {$IFDEF FMX}*0.5{$ELSE}div 2{$ENDIF})+
          '" rx="'+ToStr((X2-X1) {$IFDEF FMX}*0.5{$ELSE}div 2{$ENDIF})+
          '" ry="'+ToStr((Y2-Y1) {$IFDEF FMX}*0.5{$ELSE}div 2{$ENDIF})+'"';
end;

procedure TSVGCanvas.ClipEllipse(Const Rect:TRect; Inverted:Boolean=False);
begin
  SVGClip;
  with Rect do
    AddEnd('<ellipse '+SVGEllipse(Left,Top,Right,Bottom));
  SVGEndClip;
end;

Procedure TSVGCanvas.ClipPolygon(const Points:Array of TPoint; NumPoints:Integer;
                                 DiffRegion:Boolean=False);
begin
  SVGClip;

  //@TODO: When DiffRegion is True, 
  //clipping the difference between existing clipping region and Points polygon.

  AddEnd('<polygon '+SVGPoints(Points));
  SVGEndClip;
end;

procedure TSVGCanvas.UnClipRectangle;
begin
  if IClipStack=0 then
     raise Exception.create('oops');

  Dec(IClipStack);
  Add('</g>');
end;

procedure TSVGCanvas.StretchDraw(const Rect: TRect; const Graphic: TGraphic);
begin
end;

procedure TSVGCanvas.Draw(X, Y: Integer; const Graphic: TGraphic);
begin
end;

Function TSVGCanvas.TotalBounds:String;
begin
  result:='width="'+ToStr(Bounds.Right-Bounds.Left)+'px" '+
          'height="'+ToStr(Bounds.Bottom-Bounds.Top)+'px"';

//          'viewbox="'+IntToStr(Bounds.Left)+' '+IntToStr(Bounds.Top)+' '+
//                      IntToStr(Bounds.Right)+' '+IntToStr(Bounds.Bottom);
end;

Function TSVGCanvas.PointToStr(const X,Y:TCoordinate):String;
begin
  result:=ToStr(X)+','+ToStr(Y);
end;

Procedure TSVGCanvas.GradientFill( Const Rect:TRect;
                                  StartColor,EndColor:TColor;
                                  Direction:TGradientDirection;
                                  Balance:Integer=50;
                                  RadialX:Integer=0;
                                  RadialY:Integer=0);

  Function GradientTransform:String;
  begin
    case Direction of
       gdTopBottom : result:=' x1="0%" y1="100%" x2="0%" y2="0%" ';
       gdBottomTop : result:=' x1="0%" y1="0%" x2="0%" y2="100%" ';
       gdRightLeft : result:=' x1="0%" y1="0%" x2="100%" y2="0%" ';
       gdLeftRight : result:=' x1="100%" y1="0%" x2="0%" y2="0%" ';

       //gdFromCenter
       //gdFromTopLeft
       //gdFromBottomLeft
       //gdDiagonalUp
       //gdDiagonalDown
    end;
  end;

  procedure AddColors;
  begin
    AddEnd('<stop offset="0%" stop-color='+SVGColor(StartColor));
    AddEnd('<stop offset="100%" stop-color='+SVGColor(EndColor));
  end;

var tmp : String;
begin
  Inc(IGradientCount);
  Add('<defs>');

  if Direction=gdRadial then
  begin
    Add('<radialGradient id="Gradient'+TeeStr(IGradientCount)+'" cx="50%" cy="50%" r="50%" fx="50%" fy="50%">');
    AddColors;
    Add('</radialGradient>');
  end
  else
  begin
    Add('<linearGradient id="Gradient'+TeeStr(IGradientCount)+'" '+GradientTransform+'>');
    AddColors;
    Add('</linearGradient>');
  end;

  Add('</defs>');

  tmp:='<rect fill="url(#Gradient'+TeeStr(IGradientCount)+')" stroke="none" ';
  tmp:=tmp+SVGRect(Rect);
  AddEnd(tmp);
end;

procedure TSVGCanvas.FillRect(const Rect: TRect);
begin
  InternalRect(Rect,False);
end;

Procedure TSVGCanvas.InternalRect(Const Rect:TRect; UsePen:Boolean; RoundX,RoundY:Integer);
var tmp : String;
begin
  if (Brush.Style<>bsClear) or (UsePen and (Pen.Style<>psClear)) then
  begin
    tmp:='<rect '+SVGRect(Rect)+SVGBrushPen(UsePen);

    if (RoundX<>0) or (RoundY<>0) then
       tmp:=tmp+' rx="'+IntToStr(RoundX)+'" ry="'+IntToStr(RoundY)+'"';

    AddEnd(tmp);
  end;
end;

procedure TSVGCanvas.Ellipse(const X1, Y1, X2, Y2: TCoordinate);
var tmpSt : String;
begin
  if (Brush.Style<>bsClear) or (Pen.Style<>psClear) then
  begin
    tmpSt:='<ellipse '+SVGEllipse(X1,Y1,X2,Y2);
    AddEnd(tmpSt+SVGBrushPen);
  end;
end;

function TSVGCanvas.BeginEntity(const Entity:String; const Visual:TVisualBlock=nil; const Transform:TTeeTransform=nil):TVisualBlock;
begin
  result:=Visual;

  if Groups then
     Add('<g id="'+Entity+'">');
end;

procedure TSVGCanvas.EndEntity;
begin
  if Groups then
     Add('</g>');
end;

procedure TSVGCanvas.SetPixel3D(X,Y,Z:Integer; Value: TColor);
begin
  if Pen.Style<>psClear then
  begin
    Calc3DPos(x,y,z);
    Pen.Color:=Value;
    MoveTo(x,y);
    LineTo(x,y);
  end;
end;

procedure TSVGCanvas.SetPixel(X, Y: Integer; Value: TColor);
begin
  if Pen.Style<>psClear then
  begin
    Pen.Color:=Value;
    MoveTo(x,y);
    LineTo(x,y);
  end;
end;

class function TSVGCanvas.Description:String;
begin
  result:='SVG';
end;

procedure TSVGCanvas.Arc(const Left, Top, Right, Bottom, StartX, StartY, EndX, EndY: Integer);
var tmpSt : String;
begin
  if Pen.Style<>psClear then
  begin
    PrepareShape;
    tmpSt:='points="'+PointToStr(Left,Top)+' '+PointToStr(Right,Bottom)+' '+
                      PointToStr(StartX,StartY)+' '+PointToStr(EndX,EndY)+'"';
    AddEnd(tmpSt);
  end;
end;

procedure TSVGCanvas.Donut(XCenter,YCenter,XRadius,YRadius:Integer;
                Const StartAngle,EndAngle,HolePercent:Double);
var x3, x4, y3, y4: Integer;
    R: {$IFDEF FMX}TRectF{$ELSE}TRect{$ENDIF};

  Procedure CalcPoint(const Angle:Double; out x,y:Integer);
  var tmpSin : {$IFDEF D15}Double{$ELSE}Extended{$ENDIF};
      tmpCos : {$IFDEF D15}Double{$ELSE}Extended{$ENDIF};
  begin
    SinCos(Angle*TeePiStep,tmpSin,tmpCos);
    x:=Round(XCenter+(R.Right-R.Left)*tmpCos);
    y:=Round(YCenter-(R.Bottom-R.Top)*tmpSin);
  end;

begin
  R:={$IFDEF FMX}RectF{$ELSE}Rect{$ENDIF}(XCenter-XRadius, YCenter-YRadius, XCenter+XRadius, YCenter+YRadius);
  CalcPoint(StartAngle/TeePiStep,x3,y3);
  CalcPoint(EndAngle/TeePiStep,x4,y4);

  Pie({$IFDEF FMX}Round{$ENDIF}(R.Left), {$IFDEF FMX}Round{$ENDIF}(R.Top),
      {$IFDEF FMX}Round{$ENDIF}(R.Right), {$IFDEF FMX}Round{$ENDIF}(R.Bottom),
      x3, y3, x4, y4, HolePercent);
end;

procedure TSVGCanvas.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
begin
  Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4, 0);
end;

procedure TSVGCanvas.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer; HolePercent: Double);
var list : Array of TPointFloat;
    count : Integer;

  procedure Loop(Start,Stop:Integer; const R:TRect);

    procedure AddPoint(const AIndex:Integer);
    begin
      list[count]:=PointFromCircle(R, AIndex);
      Inc(count);
    end;

  var t : Integer;
  begin
    if Start>Stop then
       for t:=Start downto Stop do
           AddPoint(t)
    else
       for t:=Start to Stop do
           AddPoint(t);
  end;

  function RectFrom(const P:TPoint; const X,Y:Integer):TRect;
  begin
    result.Left:=P.X-X;
    result.Right:=P.X+X;
    result.Top:=P.Y-Y;
    result.Bottom:=P.Y+Y;
  end;

var tmpXCenter, tmpYCenter,
    tmpXRadius, tmpYRadius,
    StartAngle, EndAngle,
    SweepAngle: Integer;
    tmpR: TRect;
begin
  if (Brush.Style<>bsClear) or (Pen.Style<>psClear) then
  begin
    tmpXCenter:=X1+(X2-X1) div 2;
    tmpYCenter:=Y1+(Y2-Y1) div 2;

    StartAngle:=Round(ArcTan2(tmpYCenter-Y3, X3-tmpXCenter)/TeePiStep);
    EndAngle:=Round(ArcTan2(tmpYCenter-Y4, X4-tmpXCenter)/TeePiStep);

    if (StartAngle<0) and (EndAngle<>0) then
       StartAngle:=360+StartAngle;

    if EndAngle<0 then
       EndAngle:=360+EndAngle;

    SweepAngle:=EndAngle-StartAngle;

    if HolePercent>0 then
       SetLength(list, 2 + (SweepAngle * 2))
    else
    begin
      if sweepAngle < 360 then
         SetLength(list, SweepAngle + 3)
      else
         SetLength(list, SweepAngle + 1);
    end;

    count:=0;

    if (sweepAngle<360) and (HolePercent=0) then
    begin
      list[count]:={$IFNDEF FMX}TeePointFloat{$ENDIF}({$IFDEF FMX}PointF{$ELSE}Point{$ENDIF}(Round(tmpXCenter), Round(tmpYCenter)));
      Inc(count);
    end;

    Loop(StartAngle,EndAngle,{$IFDEF FMX}RectF{$ELSE}Rect{$ENDIF}(X1, Y1, X2, Y2));

    if HolePercent>0 then
    begin
      tmpXRadius:=(X2-X1) div 2;
      tmpYRadius:=(Y2-Y1) div 2;
      tmpR:=RectFrom({$IFDEF FMX}PointF{$ELSE}Point{$ENDIF}(tmpXCenter, tmpYCenter), Round(HolePercent * tmpXRadius * 0.01),Round(HolePercent * tmpYRadius * 0.01));
      Loop(EndAngle,StartAngle,tmpR);
    end;

    if (sweepAngle<360) and (HolePercent=0) then
       list[count]:={$IFNDEF FMX}TeePointFloat{$ENDIF}({$IFDEF FMX}PointF{$ELSE}Point{$ENDIF}(Round(tmpXCenter), Round(tmpYCenter)));

    {$IFDEF FMX}
    Polygon(list);
    {$ELSE}
    PolygonFloat(list);
    {$ENDIF}
  end;
end;

procedure TSVGCanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
begin
  InternalRect(TeeRect(X1,Y1,X2,Y2),True,X3,Y3);
end;

Procedure TSVGCanvas.TextOut3D(X,Y,Z:Integer; const Text:String; AllowHTML:Boolean=False);
begin
  Calc3DPos(x,y,z);
  TextOut(x,y,Text);
end;

Procedure TSVGCanvas.TextOut({$IFDEF FMX}const{$ENDIF} X,Y:TCoordinate; const Text:String);

  Procedure DoText(AX,AY:TCoordinate; AColor:TColor);
  {$IFDEF IOS}
  {$DEFINE HIDEWARNING}
  {$ENDIF}

  {$IFDEF ANDROID}
  {$DEFINE HIDEWARNING}
  {$ENDIF}

  {$IFDEF LINUX}
  {$DEFINE HIDEWARNING}
  {$ENDIF}

    Function VerifySpecial(const S:String):String;
    const AllowedSVGChars=['!'..'z'] - ['&', '<', '>', '"', ''''];
    var t : Integer;
    begin
      result:='';

      for t:=1 to Length(S) do

      {$IFDEF HIDEWARNING}
      {$WARN SYMBOL_DEPRECATED OFF}
      {$ENDIF}

      // D19: if S[t].IsInArray(AllowedSVGChars) then  ??? (error)

      if {$IFDEF D12}CharInSet(S[t], AllowedSVGChars){$ELSE}S[t] in AllowedSVGChars{$ENDIF} then

      {$IFDEF HIDEWARNING}
      {$WARN SYMBOL_DEPRECATED DEFAULT}
      {$ENDIF}

         result:=result+S[t]
      else
         case S[t] of
          '&' : result:=result + '&amp;';
          '<' : result:=result + '&lt;';
          '>' : result:=result + '&gt;';
          '"' : result:=result + '&quot;';
         '''' : result:=result + '&apos;';
         else
                result:=result + '&#'+IntToStr(Ord(S[t]))+';';
         end;
    end;

  var tmpSt : String;
  begin
    if (TextAlign and TA_CENTER)=TA_CENTER then
       AX:=AX-(TextWidth(Text) div 2)
    else
    if (TextAlign and TA_RIGHT)=TA_RIGHT then
       AX:=AX-TextWidth(Text);

    tmpSt:='<text x="'+ToStr(AX)+'" y="'+ToStr(AY)+'"'+
        ' font-family="'+Font.{$IFDEF FMX}Family{$ELSE}Name{$ENDIF}+
        '" font-size="'+ToStr(Font.Size)+'pt" ';

//    tmpSt:=tmpSt+' transform="translate(0,100) rotate(90)"';

    if {$IFDEF FMX}TFontStyle.{$ENDIF}fsItalic in Font.Style then
       tmpSt:=tmpSt+' font-style="italic"';

    if {$IFDEF FMX}TFontStyle.{$ENDIF}fsBold in Font.Style then
       tmpSt:=tmpSt+' font-weight="bold"';

    if {$IFDEF FMX}TFontStyle.{$ENDIF}fsUnderline in Font.Style then
       tmpSt:=tmpSt+' text-decoration="underline"'
    else
    if {$IFDEF FMX}TFontStyle.{$ENDIF}fsStrikeOut in Font.Style then
       tmpSt:=tmpSt+' text-decoration="line-through"';

    tmpSt:=tmpSt+' fill='+SVGColor(AColor)+SVGOpacity(False,AColor)+'>';

    Add(tmpSt);
    Add(VerifySpecial(Text));
    Add('</text>');
  end;

var X2,
    Y2 : TCoordinate;

  procedure TryDrawShadow(const AShadow:TTeeShadow; Factor:Integer);
  var tmpX,
      tmpY : TCoordinate;
  begin
    with AShadow do
    if Visible then
    begin
      if (HorizSize<>0) or (VertSize<>0) then
      begin
        if HorizSize<0 then
        begin
          tmpX:=X2;
          X2:=X2-Factor*HorizSize;
        end
        else tmpX:=X2+Factor*HorizSize;

        if VertSize<0 then
        begin
          tmpY:=Y2;
          Y2:=Y2-Factor*VertSize;
        end
        else tmpY:=Y2+Factor*VertSize;

        DoText(tmpX,tmpY,AShadow.Color);
      end;
    end;
  end;

begin
  x2:=x;
  y2:=y;

  if TextAlign<TA_BOTTOM then
     y2:=y2+{$IFDEF FMX}Font.Size{$ELSE}Round(Font.Size*Screen.PixelsPerInch/72.0){$ENDIF};  // align top

  TryDrawShadow(Font.Shadow,1);
  TryDrawShadow(Font.Emboss,-1);

  DoText(X2,Y2,Font.Color);
end;
Procedure TSVGCanvas.TextOutWithRotate({$IFDEF FMX}const{$ENDIF} X,Y:TCoordinate; const Text:String; const RotDegree:Double);

  Procedure DoText(AX,AY:TCoordinate; AColor:TColor);
  {$IFDEF IOS}
  {$DEFINE HIDEWARNING}
  {$ENDIF}

  {$IFDEF ANDROID}
  {$DEFINE HIDEWARNING}
  {$ENDIF}

  {$IFDEF LINUX}
  {$DEFINE HIDEWARNING}
  {$ENDIF}

    Function VerifySpecial(const S:String):String;
    const AllowedSVGChars=['!'..'z'] - ['&', '<', '>', '"', ''''];
    var t : Integer;
    begin
      result:='';

      for t:=1 to Length(S) do

      {$IFDEF HIDEWARNING}
      {$WARN SYMBOL_DEPRECATED OFF}
      {$ENDIF}

      if {$IFDEF D12}CharInSet(S[t], AllowedSVGChars){$ELSE}S[t] in AllowedSVGChars{$ENDIF} then

      {$IFDEF HIDEWARNING}
      {$WARN SYMBOL_DEPRECATED DEFAULT}
      {$ENDIF}
         result:=result+S[t]
      else
         case S[t] of
          '&' : result:=result + '&amp;';
          '<' : result:=result + '&lt;';
          '>' : result:=result + '&gt;';
          '"' : result:=result + '&quot;';
         '''' : result:=result + '&apos;';
         else
                result:=result + '&#'+IntToStr(Ord(S[t]))+';';
         end;
    end;
  const DoubleEpsilon: Double = 1E-12;
  var tmpSt : String;
  begin
	if IsZero(RotDegree, DoubleEpsilon) then
	begin
	  if (TextAlign and TA_CENTER)=TA_CENTER then
	    AX:=AX-(TextWidth(Text) div 2)
	  else
	  if (TextAlign and TA_RIGHT)=TA_RIGHT then
	    AX:=AX-TextWidth(Text);
	end;
    tmpSt:='<text x="'+ToStr(AX)+'" y="'+ToStr(AY)+'"'+
        ' font-family="'+Font.{$IFDEF FMX}Family{$ELSE}Name{$ENDIF}+
        '" font-size="'+ToStr(Font.Size)+'pt" ';

	if not IsZero(RotDegree, DoubleEpsilon) then
	begin
	  tmpSt:=tmpSt+' transform="rotate(' + IntToStr(Round(RotDegree)) +
									', ' + ToStr(AX) + ' , ' + ToStr(AY) + ')"';
	end;

    if {$IFDEF FMX}TFontStyle.{$ENDIF}fsItalic in Font.Style then
       tmpSt:=tmpSt+' font-style="italic"';

    if {$IFDEF FMX}TFontStyle.{$ENDIF}fsBold in Font.Style then
       tmpSt:=tmpSt+' font-weight="bold"';

    if {$IFDEF FMX}TFontStyle.{$ENDIF}fsUnderline in Font.Style then
       tmpSt:=tmpSt+' text-decoration="underline"'
    else
    if {$IFDEF FMX}TFontStyle.{$ENDIF}fsStrikeOut in Font.Style then
       tmpSt:=tmpSt+' text-decoration="line-through"';

    tmpSt:=tmpSt+' fill='+SVGColor(AColor)+SVGOpacity(False,AColor)+'>';

    Add(tmpSt);
    Add(VerifySpecial(Text));
    Add('</text>');
  end;

var X2,
    Y2 : TCoordinate;

  procedure TryDrawShadow(const AShadow:TTeeShadow; Factor:Integer);
  var tmpX,
      tmpY : TCoordinate;
  begin
    with AShadow do
    if Visible then
    begin
      if (HorizSize<>0) or (VertSize<>0) then
      begin
        if HorizSize<0 then
        begin
          tmpX:=X2;
          X2:=X2-Factor*HorizSize;
        end
        else tmpX:=X2+Factor*HorizSize;

        if VertSize<0 then
        begin
          tmpY:=Y2;
          Y2:=Y2-Factor*VertSize;
        end
        else tmpY:=Y2+Factor*VertSize;

        DoText(tmpX,tmpY,AShadow.Color);
      end;
    end;
  end;

begin
  x2:=x;
  y2:=y;

  if TextAlign<TA_BOTTOM then
     y2:=y2+{$IFDEF FMX}Font.Size{$ELSE}Round(Font.Size*Screen.PixelsPerInch/72.0){$ENDIF};  // align top

  TryDrawShadow(Font.Shadow,1);
  TryDrawShadow(Font.Emboss,-1);

  DoText(X2,Y2,Font.Color);
end;

procedure TSVGCanvas.RotateLabel3D(x,y,z:Integer; Const St:String; RotDegree:Double;
                                   AllowHTML:Boolean=False);
begin
  Calc3DPos(x,y,z);
  RotateLabel(x,y,St,RotDegree,AllowHTML);
end;

procedure TSVGCanvas.RotateLabel(x,y:Integer; Const St:String; RotDegree:Double;
                                 AllowHTML:Boolean=False);
begin
    // DrillScan fix
  TextOutWithRotate(X,Y,St,-RotDegree);
  //TODO: RotDegree text rotation
  // TextOut(X,Y,St);
end;

function TSVGCanvas.SVGOpacity(IsPen:Boolean; const AColor:TColor):String;
const AlphaByte=1/255;
var tmp : Single;
begin
  tmp:=AlphaByte*TRGBA(AColor).Alpha;

  if tmp=0 then
     tmp:=ITransp
  else
  if ITransp>0 then
     tmp:=tmp*ITransp;

  if tmp=0 then
     result:=''
  else
  begin
    if IsPen then
       result:=' stroke-opacity="'
    else
       result:=' fill-opacity="';

    result:=result+FormatFloat('0.##',tmp)+'"';
  end;
end;

Function TSVGCanvas.SVGBrushPen(UsePen:Boolean=True):String;
begin
  if Brush.Style<>bsClear then
     result:=' fill='+SVGColor(Brush.Color)+SVGOpacity(False,Brush.Color)
  else
     result:=' fill="none"';

  if UsePen then
     result:=result+SVGPen;
end;

Function TSVGCanvas.SVGPen:String;

  Function PenStyle:String;
  begin
    if Pen.SmallDots then
       result:='2, 2'
    else
    case Pen.Style of
      psDash: result:='4, 2';
      psDot: result:='2, 2';
      psDashDot: result:='4, 2, 2, 2';
      psDashDotDot: result:='4, 2, 2, 2, 2, 2';
    else
      result:='';
    end;
  end;

begin
  if Pen.Style=psClear then
     result:=' stroke="none"'
  else
  begin
    result:=' stroke='+SVGColor(Pen.Color)+SVGOpacity(True,Pen.Color);

    if Pen.Width>1 then
       result:=result+' stroke-width="'+ToStr(Pen.Width)+'"';

    if Pen.Style<>psSolid then
       result:=result+' stroke-dasharray="'+PenStyle+'" ';  //  fill="none" breaks brush ??

    case Pen.EndStyle of
      esSquare: result:=result+' stroke-linecap="square"';
      esFlat: result:=result+' stroke-linecap="flat"';
    end;
  end;
end;

Procedure TSVGCanvas.PrepareShape;
begin
  Add('<polygon'+SVGBrushPen);
end;

Function TSVGCanvas.SVGPoints(const Points: Array of TPoint):String;
var t : Integer;
begin
  result:='points="';

  for t:=Low(Points) to High(Points) do
      result:=result+PointToStr(Points[t].X,Points[t].Y)+' ';

  result:=result+'"';
end;

Procedure TSVGCanvas.Polygon({$IFDEF D6}const{$ENDIF} Points: Array of TPoint);
begin
  if (Brush.Style<>bsClear) or (Pen.Style<>psClear) then
  begin
    PrepareShape;
    AddEnd(SVGPoints(Points));
  end;
end;

Procedure TSVGCanvas.Polyline({$IFDEF D6}const{$ENDIF} Points:Array of TPoint);
begin
  if (Brush.Style<>bsClear) or (Pen.Style<>psClear) then
  begin
    Add('<polyline fill="none" '+SVGPen);
    AddEnd(SVGPoints(Points));
  end;
end;

const
  CRLF=TeeTextLineSeparator;

// If you need a diferent set of headers, override this method
// in a descendant class (ie: TMySVGCanvas.HeaderContents)
function TSVGCanvas.HeaderContents:String;
begin
  result:='version="1.1" baseProfile="full"'+CRLF+

          // Not supported in Firefox:

          (*
          'xmlns:cc="http://web.resource.org/cc/"'+CRLF+
          'xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"'+CRLF+
          'xmlns:ev="http://www.w3.org/2001/xml-events"'+CRLF+
          'xmlns:svg="http://www.w3.org/2000/svg"'+CRLF+
          *)

          'xmlns="http://www.w3.org/2000/svg"'+CRLF+
          'xmlns:xlink="http://www.w3.org/1999/xlink"'+CRLF;
end;

function TSVGCanvas.InitWindow(const DestCanvas: TCanvas;
  const A3DOptions: TView3DOptions; ABackColor: TColor; Is3D: Boolean;
  const UserRect: TRect): TRect;

var tmp : String;
begin
  result:=inherited InitWindow(DestCanvas,A3DOptions,ABackColor,Is3D,UserRect);

  Add(DocType);
  tmp:='<svg '+HeaderContents+TotalBounds;
  if Antialias then tmp:=tmp+' style="text-antialiasing:true"';

  Add(tmp+'>');

  if SVGDescription<>'' then
     Add('<desc>'+SVGDescription+'</desc>');
end;

procedure TSVGCanvas.SVGEndClip;
begin
  Add('</clipPath>');
  Add('</defs>');
end;

procedure TSVGCanvas.ClipRectangle(const Rect: TRect; RoundX,RoundY: Integer);
begin
  SVGClip;
  AddEnd('<rect '+SVGRect(Rect)+' rx="'+IntToStr(RoundX)+'" ry="'+IntToStr(RoundY)+'"');
  SVGEndClip;
end;

{ TSVGExportFormat }
function TSVGExportFormat.Description: String;
begin
  result:=TeeMsg_AsSVG;
end;

procedure TSVGExportFormat.DoCopyToClipboard;
begin
  with SVG do
  try
    TeeCopyClipboard(Text);
  finally
    Free;
  end;
end;

function TSVGExportFormat.FileExtension: String;
begin
  result:='SVG';
end;

class function TSVGExportFormat.FileFilter: String;
begin
  result:=TeeMsg_SVGFilter;
end;

Procedure TSVGExportFormat.CheckProperties;
begin
  if not Assigned(FProperties) then
     FProperties:=CreateProperties('TSVGOptions');
end;

{$IFDEF FMX}
function TSVGExportFormat.Editor(AOwner:TComponent):TForm;
{$ELSE}
function TSVGExportFormat.Options(Check:Boolean=True):TForm;
{$ENDIF}
begin
  {$IFNDEF FMX}if Check then{$ENDIF} CheckProperties;
  result:=FProperties;
end;

procedure TSVGExportFormat.SaveToStream(Stream: TStream);
begin
  with SVG do
  try
    SaveToStream(Stream);
  finally
    Free;
  end;
end;

type TTeePanelAccess=class(TCustomTeePanel);

function TSVGExportFormat.SVG: TStringList;
var tmp : TCanvas3D;
begin { return a panel or chart in SVG format into a StringList }
  CheckSize;

  result:=TStringList.Create;
  Panel.AutoRepaint:=False;
  try

    tmp:=Panel.Canvas;

    TTeePanelAccess(Panel).InternalCanvas:=nil;

    CheckProperties;

    if Assigned(FProperties) then
       FProperties.CloseQuery;

    Panel.Canvas:=TSVGCanvas.CreateText(result);
    try
      Panel.Canvas.Assign(tmp);

      if not Assigned(Panel.Parent) then
         Panel.BufferedDisplay:=True;

      TSVGCanvas(Panel.Canvas).Antialias:=FAntiAlias;
      TSVGCanvas(Panel.Canvas).SVGDescription:=FDesc;
      TSVGCanvas(Panel.Canvas).Groups:=FGroups;

      Panel.Draw(Panel.Canvas.ReferenceCanvas,TeeRect(Width,Height));
    finally
      Panel.Canvas:=tmp;
    end;

  finally
    Panel.AutoRepaint:=True;
  end;
end;

procedure TeeSaveToSVGFile( const APanel:TCustomTeePanel; FileName: String;
                            AWidth:Integer=0; AHeight: Integer=0);
begin { save panel or chart to filename in SVG format }
  with TSVGExportFormat.Create do
  try
    Panel:=APanel;
    Height:=AHeight;
    Width:=AWidth;

    if ExtractFileExt(FileName)='' then
       FileName:=FileName+'.'+FileExtension;

    SaveToFile(FileName);
  finally
    Free;
  end;
end;

Destructor TSVGExportFormat.Destroy;
begin
//  FreeAndNil(FProperties); ??
  inherited;
end;

initialization
  {$IFDEF FMX}
  TTeeExportFormats.RegisterFormat(TSVGExportFormat);
  {$ELSE}
  RegisterTeeExportFormat(TSVGExportFormat);
  {$ENDIF}
finalization
  {$IFDEF FMX}
  TTeeExportFormats.UnRegisterFormat(TSVGExportFormat);
  {$ELSE}
  UnRegisterTeeExportFormat(TSVGExportFormat);
  {$ENDIF}
end.
