teesvgcanvas.pas

TeeChart7Source 控件

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

interface

uses {$IFNDEF LINUX}
     Windows,
     {$ENDIF}
     Classes,
     {$IFDEF CLX}
     QGraphics, QForms, Types, QControls, QStdCtrls,
     {$ELSE}
     Graphics, Forms, Controls, StdCtrls,
     {$ENDIF}
     TeCanvas, TeeProcs, TeeExport;

type
  TSVGCanvas = class(TTeeCanvas3D)
  private
    { Private declarations }
    FBackColor   : TColor;
    FBackMode    : TCanvasBackMode;
    FTextAlign   : TCanvasTextAlign;
    FX           : Integer;
    FY           : Integer;
    FStrings     : TStrings;

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

    // IPenEndStyle : TPenEndStyle;
    IPenStyle    : TPenStyle;
    IPenWidth    : Integer;
    ITransp      : TTeeTransparency;

    Procedure Add(Const S:String);
    procedure AddEnd(const s:String);
    procedure ChangedPen(Sender: TObject);
    Procedure InternalRect(Const Rect:TRect; UsePen,IsRound:Boolean);
    Function PointToStr(X,Y:Integer):String;
    Procedure PrepareShape;
    Function SVGBrushPen(UsePen:Boolean=True):String;
    procedure SVGClip;
    Function SVGEllipse(X1,Y1,X2,Y2:Integer):String;
    procedure SVGEndClip;
    Function SVGPen:String;
    Function SVGPoints(const Points: Array of TPoint):String;
    Function SVGRect(Const Rect:TRect):String;
    Function TotalBounds:String;
  protected
    { Protected declarations }
    Procedure PolygonFour; override;

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

    { 3d }
    procedure SetPixel3D(X,Y,Z:Integer; Value: TColor); override;
    Procedure SetBackMode(Mode:TCanvasBackMode); override;
    Procedure SetBackColor(Color:TColor); override;
    Function GetBackMode:TCanvasBackMode; override;
    Function GetBackColor:TColor; override;
    procedure SetTextAlign(Align:TCanvasTextAlign); override;
  public
    { Public declarations }
    Antialias : Boolean;
    DocType : String;

    Constructor Create(AStrings:TStrings);

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

    procedure AssignVisiblePenColor(APen:TPen; AColor:TColor); override;  // 7.0

    procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); override;
    procedure Draw(X, Y: Integer; Graphic: TGraphic); override;
    procedure FillRect(const Rect: TRect); override;
    procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
    procedure LineTo(X,Y:Integer); override;
    procedure MoveTo(X,Y:Integer); override;
    procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); override;
    procedure Rectangle(X0,Y0,X1,Y1:Integer); override;
    procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer); override;
    procedure StretchDraw(const Rect: TRect; Graphic: TGraphic); override;
    Procedure TextOut(X,Y:Integer; const Text:String); override;
    Procedure DoHorizLine(X0,X1,Y:Integer); override;
    Procedure DoVertLine(X,Y0,Y1:Integer); override;

    procedure ClipEllipse(Const Rect:TRect; Inverted:Boolean=False); override;
    procedure ClipRectangle(Const Rect:TRect); override;
    Procedure ClipRectangle(Const Rect:TRect; RoundSize:Integer); override;
    Procedure ClipPolygon(Var Points:Array of TPoint; NumPoints:Integer); override;

    procedure UnClipRectangle; override;

    Function BeginBlending(const R:TRect; Transparency:TTeeTransparency):TTeeBlend; override;
    procedure EndBlending(Blend:TTeeBlend); override;

    Procedure GradientFill( Const Rect:TRect;
                            StartColor,EndColor:TColor;
                            Direction:TGradientDirection;
                            Balance:Integer=50); override;
    procedure RotateLabel(x,y:Integer; Const St:String; RotDegree:Double); override;
    procedure RotateLabel3D(x,y,z:Integer;
                            Const St:String; RotDegree:Double); override;
    Procedure Line(X0,Y0,X1,Y1:Integer); override;
    Procedure Polygon(const Points: array of TPoint); override;
    {$IFDEF D5}
    Procedure Polyline(const Points:Array of TPoint); override;
    {$ELSE}
    Procedure Polyline(const Points:TPointArray); override;
    {$ENDIF}

    { 3d }
    Procedure ShowImage(DestCanvas,DefaultCanvas:TCanvas; Const UserRect:TRect); override;
    Procedure HorizLine3D(Left,Right,Y,Z:Integer); override;
    procedure LineTo3D(X,Y,Z:Integer); override;
    Procedure LineWithZ(X0,Y0,X1,Y1,Z:Integer); override;
    procedure MoveTo3D(X,Y,Z:Integer); override;
    Procedure TextOut3D(X,Y,Z:Integer; const Text:String); override;
    Procedure VertLine3D(X,Top,Bottom,Z:Integer); override;
    Procedure ZLine3D(X,Y,Z0,Z1:Integer); override;
  published
  end;

  TSVGOptions = class(TForm)
    CBAntiAlias: TCheckBox;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TSVGExportFormat=class(TTeeExportFormat)
  private
    Procedure CheckProperties;
  protected
    FProperties : TSVGOptions;
    Procedure DoCopyToClipboard; override;
  public
    Destructor Destroy; override;

    function Description:String; override;
    function FileExtension:String; override;
    function FileFilter:String; override;
    Function SVG:TStringList;
    Function Options(Check:Boolean=True):TForm; override;
    Procedure SaveToStream(Stream:TStream); override;
  end;

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

implementation

{$IFNDEF CLX}
{$R *.DFM}
{$ELSE}
{$R *.xfm}
{$ENDIF}

Uses {$IFDEF CLX}
     QClipbrd,
     {$ELSE}
     Clipbrd,
     {$ENDIF}
     SysUtils;

Const TeeMsg_SVGFilter ='SVG files (*.svg)|*.svg';

{ TSVGCanvas }
Constructor TSVGCanvas.Create(AStrings:TStrings);
begin
  inherited Create;
  FStrings:=AStrings;
  UseBuffer:=False;

  Antialias:=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(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;

Function SVGColor(AColor:TColor):String;
begin
  AColor:=ColorToRGB(AColor);
  case AColor of
    clBlack: result:='"black"';
    clWhite: result:='"white"';
    clRed: result:='"red"';
    clGreen: result:='"green"';
    clBlue: result:='"blue"';
    clYellow: result:='"yellow"';
    clGray: result:='"gray"';
    clNavy: result:='"navy"';
    clOlive: result:='"olive"';
    clLime: result:='"lime"';
    clTeal:  result:='"teal"';
    clSilver:  result:='"silver"';
    clPurple:  result:='"purple"';
    clFuchsia:  result:='"fuchsia"';
    clMaroon:  result:='"maroon"';
  else
     result:='"rgb('+TeeStr(GetRValue(AColor))+','+
                     TeeStr(GetGValue(AColor))+','+
                     TeeStr(GetBValue(AColor))+')"';
  end;
end;

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

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

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

procedure TSVGCanvas.LineTo(X, Y: Integer);
var tmpSt : String;
begin
  tmpSt:='<line x1="'+IntToStr(FX)+'" y1="'+IntToStr(FY)+'" '+
               'x2="'+IntToStr(X)+ '" y2="'+IntToStr(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="'+TeeStr(Left)+'" y="'+TeeStr(Top)+'" '+
          ' width="'+TeeStr(Right-Left-1)+'"'+
          ' height="'+TeeStr(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(X1,Y1,X2,Y2:Integer):String;
begin
  result:='cx="'+IntToStr((X1+X2) div 2)+'" cy="'+IntToStr((Y1+Y2) div 2)+
        '" rx="'+IntToStr((X2-X1) div 2)+'" ry="'+IntToStr((Y2-Y1) div 2)+'"';
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(Var Points:Array of TPoint; NumPoints:Integer);
begin
  SVGClip;
  AddEnd('<polygon '+SVGPoints(Points));
  SVGEndClip;
end;

procedure TSVGCanvas.UnClipRectangle;
begin
  if IClipStack=0 then
     raise exception.create('oops');
  Dec(IClipStack);
  Add('</g>');
end;

function TSVGCanvas.GetBackColor:TColor;
begin
  result:=FBackColor;
end;

procedure TSVGCanvas.SetBackColor(Color:TColor);
begin
  FBackColor:=Color;
end;

procedure TSVGCanvas.SetBackMode(Mode:TCanvasBackMode);
begin
  FBackMode:=Mode;
end;

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

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

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

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

Function TSVGCanvas.PointToStr(X,Y:Integer):String;
begin
  result:=IntToStr(X)+','+IntToStr(Y);
end;

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

  Function GradientTransform:String;
  begin
    result:='';
    exit;
    
    result:=' gradientTransform=';

     // TODO:
    Case Direction of
       gdTopBottom  : result:=result+'"rotate(270)"';
       gdBottomTop  : result:=result+'"rotate(90)"';
       gdLeftRight  : result:=result+'"rotate(180)"';
       gdRightLeft  : result:=result+'';
       gdFromCenter : result:=result+''; { to-do }
       gdFromTopLeft: result:=result+'"rotate(45)"';
    else
       result:=result+'"rotate(315)"';
    end;
  end;

var tmp : String;
begin
  Inc(IGradientCount);
  Add('<defs>');
  Add('<linearGradient id="Gradient'+TeeStr(IGradientCount)+'" '+GradientTransform+'>');
  AddEnd('<stop offset="0%" stop-color='+SVGColor(StartColor));
  AddEnd('<stop offset="100%" stop-color='+SVGColor(EndColor));
  Add('</linearGradient>');
  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,False);
end;

Procedure TSVGCanvas.InternalRect(Const Rect:TRect; UsePen,IsRound:Boolean);
var tmp : String;
begin
  if (Brush.Style<>bsClear) or (UsePen and (Pen.Style<>psClear)) then
  begin
    tmp:='<rect '+SVGRect(Rect)+SVGBrushPen(UsePen);
    if IsRound then tmp:=tmp+' rx="5"';
    AddEnd(tmp);
  end;
end;

procedure TSVGCanvas.Ellipse(X1, Y1, X2, Y2: Integer);
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;

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;

procedure TSVGCanvas.AssignVisiblePenColor(APen:TPen; AColor:TColor);
begin
  IPenStyle:=APen.Style;
  IPenWidth:=APen.Width;
  Pen.OnChange:=nil;
  inherited;