teesvgcanvas.pas

TeeChart7Source 控件

  Pen.OnChange:=ChangedPen;
end;

procedure TSVGCanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
var tmpSt : String;
begin
  if Pen.Style<>psClear then
  begin
    PrepareShape;
    tmpSt:='points="'+PointToStr(X1,Y1)+' '+PointToStr(X2,Y2)+' '+
                      PointToStr(X3,Y3)+' '+PointToStr(X4,Y4)+'"';
    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,True);
end;

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

Procedure TSVGCanvas.TextOut(X,Y:Integer; const Text:String);

  Procedure DoText(AX,AY:Integer; AColor:TColor);

    Function VerifySpecial(S:String):String;
    const AllowedSVGChars=['!'..'z'];
    var t : Integer;
    begin
      result:='';

      for t:=1 to Length(S) do
      if {$IFDEF CLR}AnsiChar{$ENDIF}(S[t]) in AllowedSVGChars then
         result:=result+S[t]
      else
         result:=result+'&#'+IntToStr(Ord(S[t]))+';'
    end;

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

    tmpSt:='<text x="'+IntToStr(AX)+'" y="'+IntToStr(AY)+'"'+
        ' font-family="'+Font.Name+'" font-size="'+IntToStr(Font.Size)+'pt" ';

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

    if fsItalic in Font.Style then
       tmpSt:=tmpSt+' font-style="italic"';

    if fsBold in Font.Style then
       tmpSt:=tmpSt+' font-weight="bold"';

    if fsUnderline in Font.Style then
       tmpSt:=tmpSt+' text-decoration="underline"'
    else
    if fsStrikeOut in Font.Style then
       tmpSt:=tmpSt+' text-decoration="line-through"';

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

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

Var tmpX : Integer;
    tmpY : Integer;
begin
  if TextAlign<TA_BOTTOM then
     Inc(y,Round(Font.Size*Screen.PixelsPerInch/72.0));  // align top
     
  if Assigned(IFont) then
  With IFont.Shadow do
  if (HorizSize<>0) or (VertSize<>0) then
  begin
    if HorizSize<0 then
    begin
      tmpX:=X;
      X:=X-HorizSize;
    end
    else tmpX:=X+HorizSize;
    if VertSize<0 then
    begin
      tmpY:=Y;
      Y:=Y-VertSize;
    end
    else tmpY:=Y+VertSize;

    DoText(tmpX,tmpY,IFont.Shadow.Color)
  end;

  DoText(X,Y,IFont.Color);
end;

procedure TSVGCanvas.MoveTo3D(X,Y,Z:Integer);
begin
  Calc3DPos(x,y,z);
  MoveTo(x,y);
end;

procedure TSVGCanvas.LineTo3D(X,Y,Z:Integer);
begin
  Calc3DPos(x,y,z);
  LineTo(x,y);
end;

Function TSVGCanvas.GetTextAlign:TCanvasTextAlign;
begin
  result:=FTextAlign;
end;

Procedure TSVGCanvas.DoHorizLine(X0,X1,Y:Integer);
begin
  MoveTo(X0,Y);
  LineTo(X1,Y);
end;

Procedure TSVGCanvas.DoVertLine(X,Y0,Y1:Integer);
begin
  MoveTo(X,Y0);
  LineTo(X,Y1);
end;

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

procedure TSVGCanvas.RotateLabel(x,y:Integer; Const St:String; RotDegree:Double);
begin
//TODO: RotDegree text rotation
  TextOut(X,Y,St);
end;

Procedure TSVGCanvas.Line(X0,Y0,X1,Y1:Integer);
begin
  MoveTo(X0,Y0);
  LineTo(X1,Y1);
end;

Procedure TSVGCanvas.HorizLine3D(Left,Right,Y,Z:Integer);
begin
  MoveTo3D(Left,Y,Z);
  LineTo3D(Right,Y,Z);
end;

Procedure TSVGCanvas.VertLine3D(X,Top,Bottom,Z:Integer);
begin
  MoveTo3D(X,Top,Z);
  LineTo3D(X,Bottom,Z);
end;

Procedure TSVGCanvas.ZLine3D(X,Y,Z0,Z1:Integer);
begin
  MoveTo3D(X,Y,Z0);
  LineTo3D(X,Y,Z1);
end;

Procedure TSVGCanvas.LineWithZ(X0,Y0,X1,Y1,Z:Integer);
begin
  MoveTo3D(X0,Y0,Z);
  LineTo3D(X1,Y1,Z);
end;

Function TSVGCanvas.GetBackMode:TCanvasBackMode;
begin
  result:=FBackMode;
end;

Procedure TSVGCanvas.PolygonFour;
begin
  Polygon(IPoints);
end;

Function TSVGCanvas.SVGBrushPen(UsePen:Boolean=True):String;
begin
  if Brush.Style<>bsClear then
  begin
    result:=' fill='+SVGColor(Brush.Color);
    if ITransp>0 then
       result:=result+' fill-opacity="'+FloatToStr(ITransp*0.01)+'"';
  end
  else
    result:=' fill="none"';

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

Function TSVGCanvas.SVGPen:String;

  Function PenStyle:String;
  begin
    if Pen is TChartPen and TChartPen(Pen).SmallDots then
       result:='2, 2'
    else
    case IPenStyle 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);

    if IPenWidth>1 then
       result:=result+' stroke-width="'+TeeStr(IPenWidth)+'"';

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

    if Pen is TChartPen then
    case TChartPen(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(const Points: Array of TPoint);
begin
  if (Brush.Style<>bsClear) or (Pen.Style<>psClear) then
  begin
    PrepareShape;
    AddEnd(SVGPoints(Points));
  end;
end;

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

function TSVGCanvas.InitWindow(DestCanvas: TCanvas;
  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 '+TotalBounds;
  if Antialias then tmp:=tmp+' style="text-antialiasing:true"';

  Add(tmp+'>');

  Pen.OnChange:=ChangedPen;
end;

procedure TSVGCanvas.ChangedPen(Sender: TObject);
begin
  IPenStyle:=Pen.Style;
  IPenWidth:=Pen.Width;
end;

procedure TSVGCanvas.SetTextAlign(Align: TCanvasTextAlign);
begin
  FTextAlign:=Align;
end;

function TSVGCanvas.BeginBlending(const R: TRect;
 Transparency: TTeeTransparency): TTeeBlend;
begin
  ITransp:=Transparency;
  result:=nil;
end;

procedure TSVGCanvas.EndBlending(Blend: TTeeBlend);
begin
  ITransp:=0;
end;

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

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

{ TSVGExportFormat }
function TSVGExportFormat.Description: String;
begin
  result:='as &SVG';
end;

procedure TSVGExportFormat.DoCopyToClipboard;
begin
  with SVG do
  try
    Clipboard.AsText:=Text;
  finally
    Free;
  end;
end;

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

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

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

function TSVGExportFormat.Options(Check:Boolean=True):TForm;
begin
  if Check then 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;

    {$IFNDEF CLR}  // Protected across assemblies
    TTeePanelAccess(Panel).InternalCanvas:=nil;
    {$ENDIF}

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

      TSVGCanvas(Panel.Canvas).Antialias:=FProperties.CBAntiAlias.Checked;

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

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

procedure TeeSaveToSVGFile( 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);  ?? 6.02
  inherited;
end;

initialization
  RegisterTeeExportFormat(TSVGExportFormat);
finalization
  UnRegisterTeeExportFormat(TSVGExportFormat);
end.