Attachment 796 Details for Bug 1911 – Fix Bug 1911 - SVG export ignores label rotation

Steema Issues Database

Note: This database is for bugs and wishes only. For technical support help, if you are a customer please visit our online forums;
otherwise you can use StackOverflow.
Before using this bug-tracker we recommend a look at this document, Steema Bug Fixing Policy.

Fix Bug 1911 - SVG export ignores label rotation

TeeSVGCanvas.pas (text/plain), 30.24 KB, created by boris.seve on 2017-12-11 04:26:16 EST

(hide)

Description:

Filename:

MIME Type:

Creator: boris.seve

Created: 2017-12-11 04:26:16 EST

Size: 30.24 KB

patch

obsolete

>{********************************************}
>{ TeeChart Pro SVG Canvas and Exporting      }
>{ SVG : Scalable Vector Graphics             }
>{ www.w3.org/Graphics/SVG                    }
>{                                            }
>{ Copyright (c) 2001-2017 by Steema Software }
>{       All Rights Reserved                  }
>{********************************************}
>unit TeeSVGCanvas;
>{$I TeeDefs.inc}
>
>interface
>
>uses {$IFNDEF LINUX}
>     {$IFNDEF FMX}
>     Windows,
>     {$ENDIF}
>     {$ENDIF}
>     Classes, SysUtils, Math,
>
>     {$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}
>     ;
>
>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 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.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
>var tmpSt : String;
>begin
>  if (Brush.Style<>bsClear) or (Pen.Style<>psClear) then
>  begin
>    PrepareShape;
>    tmpSt:=' points="'+PointToStr((X2+X1) div 2,(Y2+Y1) div 2)+' ';
>    tmpSt:=tmpSt+PointToStr(X1,Y1)+' '+PointToStr(X2,Y2)+' '+
>                 PointToStr(X3,Y3)+' '+PointToStr(X4,Y4)+'"';
>
>    AddEnd(tmpSt);
>  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);
>
>    Function VerifySpecial(const S:String):String;
>    const AllowedSVGChars=['!'..'z'] - ['&', '<', '>', '"', ''''];
>    var t : Integer;
>    begin
>      result:='';
>
>      for t:=1 to Length(S) do
>
>      {$IFDEF IOS}
>      {$WARN SYMBOL_DEPRECATED OFF}
>      {$ENDIF}
>
>      {$IFDEF ANDROID}
>      {$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 ANDROID}
>      {$WARN SYMBOL_DEPRECATED DEFAULT}
>      {$ENDIF}
>
>      {$IFDEF IOS}
>      {$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);
>
>    Function VerifySpecial(const S:String):String;
>    const AllowedSVGChars=['!'..'z'] - ['&', '<', '>', '"', ''''];
>    var t : Integer;
>    begin
>      result:='';
>
>      for t:=1 to Length(S) do
>
>      {$IFDEF IOS}
>      {$WARN SYMBOL_DEPRECATED OFF}
>      {$ENDIF}
>
>      {$IFDEF ANDROID}
>      {$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 ANDROID}
>      {$WARN SYMBOL_DEPRECATED DEFAULT}
>      {$ENDIF}
>
>      {$IFDEF IOS}
>      {$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.

Actions: View

Attachments on bug 1911: 776 | 777 | 796