{************************************************************}
{                   Delphi VCL Extensions                    }
{                                                            }
{                   Export CAD to SVG                        }
{                                                            }
{      Copyright (c) 2002-2013 SoftGold software company     }
{                                                            }
{************************************************************}
unit CADtoSVG;
{$INCLUDE SGDXF.INC}

interface

uses Windows, SysUtils, Classes, Graphics, Math, CADExport, CADImage, sgConsts,
  DXFConv, SGBitmap, sgXMLParser
{$IFDEF SGDEL_XE2}
  , System.Types
{$ENDIF}
{$IFDEF SG_USE_PNG}
  , pngimage
{$ELSE}
  {$IFDEF SGDEL_XE2}
  , Vcl.Imaging.jpeg
  {$ELSE}
  , jpeg
  {$ENDIF}
{$ENDIF};

//{$DEFINE SG_DEBUG}

type

  TsgCADtoSVG = class(TsgSimpleExport)
  private
    FStream: TStream;
    FVersion: string;
    FHasLine: Boolean;
    FHasFill: Boolean;
    FLineColor: TColor;
    FFillColor: TColor;
    FPrecision: Double;
    FWeight: Integer;
    FNullWidth: Boolean;
    procedure ExportLine(const Points);
    procedure ExportPath(const Points; const Counts; Count: Integer; const AClosed: Boolean);
    procedure ExportPoints(const Points; ACount: Integer; const AClosed: Boolean);
    procedure ExportPoly(const Points; ACount: Integer; const AClosed: Boolean);
    procedure ExportRect(const R: PRect);
    procedure ExpData(const AValue: string);
    procedure DefineStyle;
    procedure SetPrecision(const Value: Double);
  protected
    procedure ExportHeader;
    procedure ExportBodyStart;
    procedure ExportBodyEnd;
    procedure ExpFillRgn(P: PRect; Count: Integer); override;
    procedure ExpPolyline(const Points; Count: Integer); override;
    procedure ExpPolygon(const Points; Count: Integer); override;
    procedure ExpPolyPolyline(const Points; const Counts; Count: Integer); override;
    procedure ExpPolyPolygon(const Points; const Counts; Count: Integer); override;
    procedure ExpImage(const R: TRect; AImage: TGraphic); override;
    procedure ExpImageUV(const APoint1, APoint2, APoint3,  APoint4: TPoint;
      AImage: TGraphic); override;
    procedure ExpSaveDC; override;
    procedure ExpRestoreDC; override;
    procedure PageEnd(N: Integer); override;
    procedure PageStart(N: Integer); override;
    procedure SaveToStreamCustom(S: TStream); override;
    function ValueToStr(const AValue: Integer): string;
  public
    constructor Create(ACADImage: TsgDXFImage); override;
    property Version: string read FVersion write FVersion;
    property Precision: Double read FPrecision write SetPrecision;
    property NullWidth: Boolean read FNullWidth write FNullWidth;
  end;

implementation

uses
  sgZip, sgFunction;

const
  cnstCR = #13#10;
  cnstMaxSize = $FFFF;
  cnstPrecision = 1;
  cnstDocType = '<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">' + cnstCR;
  cnstHeadSVG = '<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">';
  cnstHeadSVGEnd = '</svg>' + cnstCR;
  cnstHeadXML = '<?xml version="1.0" standalone="no"?>' + cnstCR;
  cnstTagEnd = '/>' + cnstCR;
  cnstTitle = '  <title>Export to SVG</title>' + cnstCR;
  cnstDescBegin = '  <desc>Generated by CADtoSVG Version 1.0: ';
  cnstDescEnd = '</desc>' + cnstCR;

type
  TsgInteger = {$IFDEF SGDEL_4}Int64{$ELSE}Integer{$ENDIF};
  TsgBMAdapterAccess = class(TsgBMAdapter);

function GetColor(AColor: TColor): string;
var
  vColors: array [0..3] of Byte absolute AColor;
  vBuf: Byte;
begin
  vBuf := vColors[0];
  vColors[0] := vColors[2];
  vColors[2] := vBuf;
  Result := '#' + IntToHex(AColor, 6);
end;

function GetsgDataTime: string;
begin
  Result :=  FormatDateTime('dd/mm/yyyy ', Now) + FormatDateTime('hh:nn:ss', Time);
end;

{ TsgCADtoSVG }


constructor TsgCADtoSVG.Create(ACADImage: TsgDXFImage);
begin
  inherited Create(ACADImage);
  FVersion := '1.0';
  FPrecision := cnstPrecision;
end;

procedure TsgCADtoSVG.DefineStyle;
var
  vStyle: string;
begin
  vStyle := ' style="';
  if FHasLine then
    vStyle := vStyle + 'stroke:' + GetColor(FLineColor) + '; '
  else
    vStyle := vStyle + 'stroke:None; ';
  if FHasFill then
    vStyle := vStyle + 'fill:' + GetColor(FFillColor) + ';'
  else
    vStyle := vStyle + 'fill:None;';
  if not NullWidth then
    vStyle := vStyle + ' stroke-width:'  + ValueToStr(50) + ';';
  vStyle := vStyle + '"';
  ExpData(vStyle);
end;

procedure TsgCADtoSVG.ExpData(const AValue: string);
var
  vStr: sgRawByteString;
begin
{$IFDEF SGDEL_2009}
  vStr := ConvertToAnsiString(AValue, CP_ACP);
{$ELSE}
  vStr := AValue;
{$ENDIF}
  FStream.Write(vStr[1], Length(vStr) * SizeOf(vStr[1]));
end;

procedure TsgCADtoSVG.ExpFillRgn(P: PRect; Count: Integer);
var
  vPts: array[0..3] of Integer;
begin
  FHasLine := True;
  FHasFill := True;
  FFillColor := GetFillColor;
  FLineColor := FFillColor;
  while Count > 0 do
  begin
    if (P^.Bottom - P^.Top > 1) and (P^.Right - P^.Left > 1)  then
      ExportRect(P)
    else
    begin
      vPts[0] := P^.Left;
      vPts[1] := P^.Top;
      vPts[2] := P^.Right;
      vPts[3] := P^.Bottom;
      ExportLine(vPts);
    end;
    Inc(P);
    Dec(Count);
  end;
end;

procedure TsgCADtoSVG.ExpImage(const R: TRect; AImage: TGraphic);
begin
  ExpImageUV(Point(R.Left,R.Bottom),R.BottomRight,
    Point(R.Right,R.Top),R.TopLeft, AImage);
end;

procedure TsgCADtoSVG.ExpImageUV(const APoint1, APoint2, APoint3,
  APoint4: TPoint; AImage: TGraphic);
var
  vImage, vEnCode, vMatrixStr, vTypeImage: string;
  vMemStream, vMemStreamEnCode: TMemoryStream;
  vExportGraphic: TGraphic;
  vBM: TsgBMAdapter;
  vChar: AnsiChar;
  vUvector, vVvector: TFPoint;
  vMatrix: TFMatrix;
begin
  if (AImage.Width < 1) or (AImage.Height < 1) then
    Exit;
  if IsGreatImage(AImage) then
    Exit;
{$IFDEF SG_USE_PNG}
  vExportGraphic :={$IFDEF SGDEL_2009}TPngImage{$ELSE}TPngObject{$ENDIF}.Create;
  vTypeImage := 'png';
{$ELSE}
  vExportGraphic := TJpegImage.Create;
  vTypeImage := 'jpeg';
{$ENDIF}
  vBM := TsgBMAdapter.Create;
  try
    vBM.Assign(AImage);
    vExportGraphic.Assign(vBM.Bitmap);
    vMemStream := TMemoryStream.Create;
    try
      vExportGraphic.SaveToStream(vMemStream);
      vMemStreamEnCode := TMemoryStream.Create;
      try
        vMemStream.Seek(0, soFromBeginning);
        EncodeBase64(TStream(vMemStream),TStream(vMemStreamEnCode));

        vUvector := SubFPoint2D(MakeFPoint(APoint1.X, APoint1.Y),
          MakeFPoint(APoint4.X, APoint4.Y));
        vVvector := SubFPoint2D(MakeFPoint(APoint3.X, APoint3.Y),
          MakeFPoint(APoint4.X, APoint4.Y));

        vMatrix := sgFunction.FMat2DByImage(MakeFPoint(APoint4.X, APoint4.Y),
          vUvector, vVvector, AImage.Width, AImage.Height);

        vMatrixStr := 'transform=" matrix(' +
        DoubleToStr(vMatrix.V1[0], GetDecimalSeparator)+ ', ' +
        DoubleToStr(vMatrix.V1[1], GetDecimalSeparator)+ ', ' +
        DoubleToStr(vMatrix.V2[0], GetDecimalSeparator)+ ', ' +
        DoubleToStr(vMatrix.V2[1], GetDecimalSeparator)+ ', ' +
        DoubleToStr(vMatrix.V4[0], GetDecimalSeparator) + ', ' +
        DoubleToStr(vMatrix.V4[1], GetDecimalSeparator) + ')" ';

        vImage := '<image ';
        vImage := vImage + 'x="' + ValueToStr(0) + '" ';
        vImage := vImage + 'y="' + ValueToStr(0) + '" ';
        vImage := vImage + 'width="' + ValueToStr(AImage.Width) + '" ';
        vImage := vImage + 'height="' + ValueToStr(AImage.Height) + '" ';
        vImage := vImage + vMatrixStr;
        vMemStreamEnCode.Position := vMemStreamEnCode.Size;
        vChar := #0;
        vMemStreamEnCode.Write(vChar, 1);
        vEnCode := string(AnsiString(PAnsiChar(vMemStreamEnCode.Memory)));
        vImage := vImage + 'xlink:href="data:image/' + vTypeImage+';base64,' +
          vEnCode + '"/> '+ cnstCR;
        ExpData(vImage);
      finally
        vMemStreamEnCode.Free;
      end;
    finally
      vMemStream.Free;
    end;
  finally
    vExportGraphic.Free;
    vBM.Free;
  end;
end;

procedure TsgCADtoSVG.ExportBodyEnd;
begin
  ExpData(cnstHeadSVGEnd);
end;

procedure TsgCADtoSVG.ExportBodyStart;
var
  vHeader, vViewBox: string;

begin
  vHeader := cnstHeadSVG;
  vViewBox := ' viewBox="0 0 ' +
    ValueToStr(cnstMaxSize) + ' '+ ValueToStr(cnstMaxSize) + '"';
  Insert(vViewBox, vHeader, Length(vHeader));
  ExpData(vHeader + cnstCR);
  ExpData(cnstTitle);
  ExpData(cnstDescBegin + GetsgDataTime + cnstDescEnd);
end;

procedure TsgCADtoSVG.ExportHeader;
begin
  ExpData(cnstHeadXML);
  ExpData(cnstDocType);
end;

procedure TsgCADtoSVG.ExportLine(const Points);
var
  vPoly: string;
  P: PInteger;
begin
  P := @Points;
  vPoly := '<line x1="' + ValueToStr(P^);
  Inc(P);
  vPoly := vPoly + '" y1="' + ValueToStr(P^);
  Inc(P);
  vPoly := vPoly + '" x2="' + ValueToStr(P^);
  Inc(P);
  vPoly := vPoly + '" y2="' + ValueToStr(P^) + '"';
  ExpData(vPoly);
  DefineStyle;
  ExpData(cnstTagEnd);
end;

procedure TsgCADtoSVG.ExpPolyline(const Points; Count: Integer);
begin
  FHasLine := True;
  FHasFill := False;
  FLineColor := GetStrokeColor;
  FWeight := 0;
  ExportPoints(Points, Count, False);
end;

procedure TsgCADtoSVG.ExpPolyPolygon(const Points, Counts; Count: Integer);
begin
  FHasLine := False;
  FHasFill := True;
  FFillColor := GetFillColor;
  FWeight := 0;
  ExportPath(Points, Counts, Count, True);
end;

procedure TsgCADtoSVG.ExpPolyPolyline(const Points, Counts; Count: Integer);
begin
  FHasLine := True;
  FHasFill := False;
  FLineColor := GetStrokeColor;
  FWeight := 0;
  ExportPath(Points, Counts, Count, False);
end;

procedure TsgCADtoSVG.ExpPolygon(const Points; Count: Integer);
begin
  FHasLine := False;
  FHasFill := True;
  FFillColor := GetFillColor;
  FWeight := 0;
  ExportPoints(Points, Count, True);
end;

procedure TsgCADtoSVG.ExpSaveDC;
begin
end;

procedure TsgCADtoSVG.ExpRestoreDC;
begin
end;

procedure TsgCADtoSVG.PageEnd(N: Integer);
begin
  if N > 0 then
    ExpData('</g>' + cnstCR);
end;

procedure TsgCADtoSVG.PageStart(N: Integer);
var
  vMax: Integer;
  vBoundsRect: TRect;
begin
  if N > 0 then
    ExpData('<g  id="Page' + IntToStr(N) +'" display="none">' + cnstCR)
  else
  begin
    vBoundsRect := GetExportRect;
    vMax := MaxI(vBoundsRect.Right - vBoundsRect.Left, vBoundsRect.Bottom - vBoundsRect.Top);
    if (vMax < cnstMaxSize) and (vMax > 0) then
      XScale := cnstMaxSize/vMax;
  end;
end;

procedure TsgCADtoSVG.ExportPath(const Points; const Counts; Count: Integer; const AClosed: Boolean);
var
  PP, PC, P: PInteger;
  C, vCnt, X, Y: Integer;
  vPath, vPts: string;
begin
  vPath := '<path d="';
  PP := @Points;
  PC := @Counts;
  while Count > 0 do
  begin
    C := PC^;
    Inc(PC);
    P := PP;
    vCnt := C;
    if vCnt > 0 then
    begin
      X := P^; Inc(P);
      Y := P^; Inc(P);
      vPts := 'M' + ValueToStr(X) + ',' + ValueToStr(Y) + ' ';
      Dec(vCnt);
    end;
    while vCnt > 0 do
    begin
      X := P^; Inc(P);
      Y := P^; Inc(P);
      vPts := vPts + 'L' + ValueToStr(X) + ',' + ValueToStr(Y) + ' ';
      Dec(vCnt);
    end;
    if AClosed then
    begin
      P := PP;
      X := P^; Inc(P);
      Y := P^;
      vPts := vPts + 'L' + ValueToStr(X) + ',' + ValueToStr(Y) + ' ';
    end;
    vPath := vPath + vPts;
    Inc(PP, C*2);
    Dec(Count);
  end;
  ExpData(vPath + '"');
  DefineStyle;
  ExpData(cnstTagEnd);
end;

procedure TsgCADtoSVG.ExportPoints(const Points; ACount: Integer; const AClosed: Boolean);
begin
  if ACount < 3 then
    ExportLine(Points)
  else
    ExportPoly(Points, ACount, AClosed);
end;

procedure TsgCADtoSVG.ExportPoly(const Points; ACount: Integer; const AClosed: Boolean);
var
  vPoly: string;
  X, Y: Integer;
  P: PInteger;
begin
  vPoly := '<polyline points="';
  P := @Points;
  while ACount > 0 do
  begin
    X := P^; Inc(P);
    Y := P^; Inc(P);
    vPoly := vPoly + ValueToStr(X) + ',' + ValueToStr(Y) + ' ';
    Dec(ACount);
  end;
  if AClosed then
  begin
    P := @Points;
    X := P^; Inc(P);
    Y := P^;
    vPoly := vPoly + ValueToStr(X) + ',' + ValueToStr(Y) + ' ';
  end;
  ExpData(vPoly + '"');
  DefineStyle;
  ExpData(cnstTagEnd);
end;

procedure TsgCADtoSVG.ExportRect(const R: PRect);
var
  vRect: string;
begin
  vRect := '<rect x="' + ValueToStr(R^.Left) + '" y="' + ValueToStr(R^.Top) +
    '" width="' + ValueToStr(R^.Right - R^.Left) + '" height="' + ValueToStr(R^.Bottom - R^.Top) + '"';
  ExpData(vRect);
  DefineStyle;
  ExpData(cnstTagEnd);
end;

procedure TsgCADtoSVG.SaveToStreamCustom(S: TStream);
var
  vSaveDC: Char;
{$IFDEF SG_DEBUG}
  vTickCount: Cardinal;
{$ENDIF}
begin
{$IFDEF SG_DEBUG}
  vTickCount := GetTickCount;
{$ENDIF}
  Converter.IsCrossoverMatrix := False;
  FStream := S;
  vSaveDC := SetDecimalSeparator('.');
  try
    ExportHeader;
    ExportBodyStart;
    try
      inherited SaveToStreamCustom(FStream);
    finally
      ExportBodyEnd;
    end;
  finally
    SetDecimalSeparator(vSaveDC);
    FStream := nil;
    Converter.IsCrossoverMatrix := True;
  end;
{$IFDEF SG_DEBUG}
  MessageBox(0, PChar('TickCount= '+IntToStr(GetTickCount - vTickCount)), 'SVG EXPORT DEBUG MODE', MB_OK or MB_ICONINFORMATION);
{$ENDIF}
end;

procedure TsgCADtoSVG.SetPrecision(const Value: Double);
begin
  FPrecision := Value;
  if FPrecision <= 0 then
    FPrecision := cnstPrecision;
end;

function TsgCADtoSVG.ValueToStr(const AValue: Integer): string;
begin
  Result := DoubleToStr(AValue * FPrecision, cnstPoint);
end;

end.
