BSOne.SFC/EM.Lib/ImageEn_SRC/Source/iexSVG.pas

(* ImageEn Build 7.0.0.06.2637 @ 7-4-17 14:58:42.679 *)
(*
Copyright (c) 1998-2017 by Carlotta Calandra. All rights reserved.
Copyright (c) 2011-2017 by Xequte Software.

This software comes without express or implied warranty.
In no case shall the author be liable for any damage or unwanted behavior of any
computer hardware and/or software.

Author grants you the right to include the component
in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE.

ImageEn, IEvolution and ImageEn ActiveX may not be included in any
commercial, shareware or freeware libraries or components.

www.ImageEn.com
*)

(*
File: iexSVG.pas
Description: Exporting to Scalable Vector Graphics format
File version 1001
Doc revision 1001
*)



unit iexSVG;


{$R-}
{$Q-}

{$I ie.inc}

interface

uses
  {$ifdef IEHASUITYPES} System.UITypes, {$endif}
  Windows, Messages, Graphics, Controls, Forms, Classes, SysUtils, StdCtrls, ExtCtrls, Contnrs, hyiedefs, iexBitmaps, ieview,
  hyieutils;

  procedure WriteSVGFileOrStream(const FileName: String; Stream: TStream; IEView: TIEView; Bitmap: TIEBitmap; ImageFormat: TIOFileType; var xProgress: TProgressRec);



  function CreateSVGImageTag(Bitmap: TIEBitmap; SaveFormat: TIOFileType; X, Y, Width, Height: Integer;
                             BorderWidth: Integer = 1; BorderColor: TColor = clNone_;
                             Rotate: Double = 0; Transparency: Integer = 255): string;
  function CreateSVGShapeTag(Shape: TIEShape; X, Y, Width, Height: Integer; BorderWidth: Integer; BorderColor: TColor; FillColor: TColor;
                             Rotate: Double; Transparency: Integer): string;
  function CreateSVGLineTag(Point1, Point2: TPoint; LineWidth: Integer; LineColor: TColor; Transparency: Integer): string;
  function CreateSVGPolylineTag(Points: array of TPoint; PointCount: Integer; Closed: Boolean; BorderWidth: Integer; BorderColor: TColor; FillColor: TColor;
                                Rotate: Double; RotateCenter: TPoint; Transparency: Integer): string;
  function CreateSVGTextTag(Text: string; Font: TFont; X, Y, Width, Height: Integer;
                            TextAlign: TIEAlignment; TextLayout: TIELayout; TextAngle: Double;
                            BorderWidth: Integer; BorderColor: TColor; FillColor: TColor;
                            BorderShape : TIEShape; Transparency: Integer): string;


implementation

uses
  {$ifdef DelphiXE5orNewer}System.Types,{$endif}
  imageenview, math, imageenio, iexCanvasUtils, ietextc, iesettings, ievect
  {$IfDef UNICODE}, AnsiStrings {$EndIf};

const
  SVG_Opening_Tag   = '<svg width="%dpx" height="%dpx" viewBox="%d %d %d %d" version="1.1" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">';
  SVG_Closing_Tag   = '</svg>';
  SVG_Image_Tag     = '<image x="%dpx" y="%dpx" width="%dpx" height="%dpx" xlink:href="data:image/%s;base64,%s"%s />';
  SVG_Rectangle_Tag = '<rect x="%dpx" y="%dpx" width="%dpx" height="%dpx" stroke="%s" stroke-width="%dpx" fill="%s"%s />';
  SVG_RoundRect_Tag = '<rect x="%dpx" y="%dpx" width="%dpx" height="%dpx" rx="%dpx" ry="%dpx" stroke="%s" stroke-width="%dpx" fill="%s"%s />';
  SVG_Ellipse_Tag   = '<ellipse cx="%dpx" cy="%dpx" rx="%dpx" ry="%dpx" stroke="%s" stroke-width="%dpx" fill="%s"%s />';
  SVG_Polygon_Tag   = '<polygon points="%s" stroke="%s" stroke-width="%dpx" fill="%s"%s />';
  SVG_Polyline_Tag  = '<polyline points="%s" stroke="%s" stroke-width="%dpx" fill="none"%s />';
  SVG_Text_Tag      = '<text x="%dpx" y="%dpx" text-anchor="%s" dominant-baseline="%s" font-family="%s" font-size="%dpt" fill="%s"%s>%s</text>';
  SVG_Line_Tag      = ' <line x1="%d" y1="%d" x2="%d" y2="%d" stroke="%s" stroke-width="%dpx"%s />';
  XML_Comment_Block = '<!-- %s -->';

function ColorToSVG(Color: TColor): string;
begin
  if Color = clNone_ then
    Result := 'none'
  else
    Result := ColorToHex( Color );
end;


// Note: Result is prefixed with space
function GetSVGRotationElement(Angle: Double; RotateCenter: TPoint): string;
const
  SVG_Trans_Rotation_Element = ' transform="rotate(%d %d %d)"';
begin
  Result := '';
  if Angle <> 0 then
    Result := format( SVG_Trans_Rotation_Element, [ -Round( Angle ), RotateCenter.X, RotateCenter.Y ]);
end;

// Transparency: 255=opaque, 0=transparent
// Note: Result is prefixed with space
function GetSVGTransparencyElement(Transparency: Integer): string;
const
  SVG_Opacity_Element = '  opacity="%s"';
begin
  Result := '';
  if Transparency <> 255 then
    Result := format( SVG_Opacity_Element, [ IEFloatToFormatString( Transparency / 255, 2, True )]);
end;


function CreateSVGLineTag(Point1, Point2: TPoint; LineWidth: Integer; LineColor: TColor; Transparency: Integer): string;
begin
  Result := format( SVG_Line_Tag, [  Point1.X,
                                     Point1.Y,
                                     Point2.X,
                                     Point2.Y,
                                     ColorToSVG( LineColor ), LineWidth,
                                     GetSVGTransparencyElement( Transparency ) ]);
end;

function CreateSVGPolylineTag(Points: array of TPoint; PointCount: Integer; Closed: Boolean; BorderWidth: Integer; BorderColor: TColor; FillColor: TColor;
                              Rotate: Double; RotateCenter: TPoint; Transparency: Integer): string;
var
  i: Integer;
  pointStr: string;
begin
  Result := '';
  pointStr := '';
  for i := 0 to PointCount - 1 do
    pointStr := pointStr + format( '%d,%d  ', [ Points[i].X, Points[i].Y ]);

  if pointStr = '' then
    exit;

  SetLength( pointStr, Length( pointStr ) - 2 );

  if Closed then
    Result := format( SVG_Polygon_Tag, [ pointStr, ColorToSVG( BorderColor ), BorderWidth, ColorToSVG( FillColor ),
                                         GetSVGRotationElement( Rotate, RotateCenter ) + GetSVGTransparencyElement( Transparency ) ])
  else
    Result := format( SVG_Polyline_Tag, [ pointStr, ColorToSVG( BorderColor ), BorderWidth,
                                          GetSVGRotationElement( Rotate, RotateCenter ) + GetSVGTransparencyElement( Transparency ) ]);
end;


function CreateSVGShapeTag(Shape: TIEShape; X, Y, Width, Height: Integer; BorderWidth: Integer; BorderColor: TColor; FillColor: TColor;
                           Rotate: Double; Transparency: Integer): string;
const
  Rect_Rounding = 20;
var
  arPts   : Array[ 0 .. Shape_Array_Max_Points ] of TPoint;
  pts: Integer;
  RotateCenter: TPoint;
begin
  Result := '';
  if (( BorderWidth = 0 ) or ( BorderColor = clNone_ )) and
     ( FillColor = clNone_ ) then
    exit; // Nothing to see

  RotateCenter := Point( X + Width div 2, Y + Height div 2 );

  case Shape of
    iesRectangle : Result := format( SVG_Rectangle_Tag, [ X, Y, Width, Height, ColorToSVG( BorderColor ), BorderWidth, ColorToSVG( FillColor ),
                                                          GetSVGRotationElement( Rotate, RotateCenter ) + GetSVGTransparencyElement( Transparency ) ]);
    iesRoundRect : Result := format( SVG_RoundRect_Tag, [ X, Y, Width, Height, Rect_Rounding, Rect_Rounding, ColorToSVG( BorderColor ), BorderWidth, ColorToSVG( FillColor ),
                                                          GetSVGRotationElement( Rotate, RotateCenter ) + GetSVGTransparencyElement( Transparency ) ]);
    iesEllipse   : Result := format( SVG_Ellipse_Tag, [ X + Width div 2, Y + Height div 2, Width div 2, Height div 2, ColorToSVG( BorderColor ), BorderWidth, ColorToSVG( FillColor ),
                                                        GetSVGTransparencyElement( Transparency ) ]); // No rotation of ellipses
    else
    try
      IEGenerateShapePoints( arPts, pts, Shape, X, Y, Width, Height );
      Result := CreateSVGPolylineTag( arPts, pts, True, BorderWidth, BorderColor, FillColor, Rotate, RotateCenter, Transparency );
    except
      // UNSUPPORTED SHAPE
    end;
  end;
end;


function CreateSVGImageTag(Bitmap: TIEBitmap; SaveFormat: TIOFileType; X, Y, Width, Height: Integer;
                           BorderWidth: Integer = 1; BorderColor: TColor = clNone_;
                           Rotate: Double = 0; Transparency: Integer = 255): string;
var
  io: TImageEnIO;
  ms: TMemoryStream;
  base64Img: Ansistring;
  fileType: string;
  RotateCenter: TPoint;
begin
  // todo: support masking https://www.w3.org/TR/SVG/masking.html#MaskProperty
  Result := '';
  if ( Bitmap.Width < 2 ) or ( Bitmap.Height < 2 ) then
    exit;
  ms := TMemoryStream.Create();
  io := TImageEnIO.Create( nil );
  try
    io.AttachedIEBitmap := Bitmap;
    io.SaveToText( ms, SaveFormat, ietfBase64);
    SetString( base64Img , PAnsiChar( ms.Memory), ms.Size );
  finally
    io.AttachedIEBitmap := nil;
    FreeAndNil( io );
    FreeAndNil( ms );
  end;

  fileType := IEFileFormatGetInfo( SaveFormat ).SuitableExtension;
  RotateCenter := Point( X + Width div 2, Y + Height div 2 );

  if ( Length( base64Img ) > 2 ) and ( base64Img[ Length( base64Img ) - 1] = #13 ) and ( base64Img[ Length( base64Img )] = #10 ) then
    SetLength( base64Img, Length( base64Img ) -2 );

  Result := format( SVG_Image_Tag, [ X, Y, Width, Height, fileType, base64Img,
                    GetSVGRotationElement( Rotate, RotateCenter ) + GetSVGTransparencyElement( Transparency )]) +
            CreateSVGShapeTag( iesRectangle, X, Y, Width, Height, BorderWidth, BorderColor, clNone_, Rotate, Transparency );
end;


function IEEncodeHTMLString(Text: String): String;
var
  i: integer;
begin
  result := '';
  for i := 1 to length( Text ) do
  begin
    if Text[i] = '"' then
      result := result + '&quot;'
    else
    if Text[i] = '<' then
      result := result + '&lt;'
    else
    if Text[i] = '>' then
      result := result + '&gt;'
    else
    if Text[i] = '''' then
      result := result + '&apos;'
    else
    if Text[i] = '&' then
      result := result + '&amp;'
    else
      result := result + Text[i];
  end;
end;


function CreateSVGTextTag(Text: string; Font: TFont; X, Y, Width, Height: Integer;
                          TextAlign: TIEAlignment; TextLayout: TIELayout; TextAngle: Double;
                          BorderWidth: Integer; BorderColor: TColor; FillColor: TColor;
                          BorderShape : TIEShape; Transparency: Integer): string;
const
  Use_Dominant_Baseline = False;         // Supported by Chrome and Firefox, but not IE
  Fallback_Fonts = ', Arial, Helvetica'; // Fonts to use if the specified font is not supported
var
  borderPadding: Integer;
  fontFamily: string;
  fontStyle, fontWeight: string;
  shapeTag, textTag: string;
  textX, textY: Integer;
  textAnchor, alignBaseline: string;
  RotateCenter: TPoint;
begin
  Result := '';
  borderPadding := 0;
  if BorderColor <> clNone_ then
    borderPadding := BorderWidth + 3;

  case TextAlign of
    iejLeft   : begin
                  textX := X + borderPadding;
                  textAnchor := 'start';
                end;
    iejRight  : begin
                  textX := X + Width - borderPadding;
                  textAnchor := 'end';
                end;
    else        begin
                  textX := X + Width div 2;
                  textAnchor := 'middle';
                end;
  end;

  alignBaseline := 'hanging';
  if Use_Dominant_Baseline then
    case TextLayout of
      ielTop     : begin
                    textY := Y + borderPadding;
                    alignBaseline := 'hanging';
                  end;
      ielBottom  : begin
                    textY := Y + Height - borderPadding;
                    alignBaseline := 'baseline';
                  end;
      else        begin
                    textY := Y + Height div 2;
                    alignBaseline := 'middle';
                  end;
    end
  else
    case TextLayout of
      ielTop     : textY := Y + borderPadding + abs( Font.Height );
      ielBottom  : textY := Y + Height - borderPadding;
      else         textY := Y + Height - ( Height - abs( Font.Height )) div 2;
    end;

  fontStyle := '';
  if fsItalic in Font.Style then
    fontStyle := ' font-style="italic"';
  fontWeight := '';
  if fsBold in Font.Style then
    fontWeight := ' font-weight="bold"';

  fontFamily := Font.Name;
  if Pos( ' ', fontFamily ) > 0 then
    fontFamily := '''' + fontFamily + '''';

  RotateCenter := Point( X + Width div 2, Y + Height div 2 );

  shapeTag := CreateSVGShapeTag( BorderShape, X, Y, Width, Height, BorderWidth, BorderColor, FillColor, 0 { only text rotates }, Transparency);
  textTag  := format( SVG_Text_Tag, [ textX, textY, textAnchor, alignBaseline, fontFamily + Fallback_Fonts, Font.Size, ColorToSVG( Font.Color ),
                                      fontStyle + fontWeight + GetSVGRotationElement( TextAngle, RotateCenter ) + GetSVGTransparencyElement( Transparency ),
                                      IEEncodeHTMLString( Text )]);

   Result := shapeTag + textTag;
end;



procedure WriteSVGFileOrStream(const FileName: String; Stream: TStream; IEView: TIEView; Bitmap: TIEBitmap; ImageFormat: TIOFileType; var xProgress: TProgressRec);
var
  commentBlock: string;
  ss: TStringList;
  iev: TImageEnView;
  layersRect: TIERectangle;

  procedure _GetLayerSVG(IEView: TImageEnView);
  var
    I: Integer;
    layerTag: string;
  begin
    for I := 0 to IEView.LayersCount - 1 do
    begin
      if assigned(xProgress.fOnProgress) then
        xProgress.fOnProgress( xProgress.Sender, Round( i / IEView.LayersCount * 100 ));
      if IEView.Layers[ I ].Visible and not IEView.Layers[ I ].IsMask then
      begin
        layerTag := IEView.Layers[ I ].AsSVG;
        if layerTag <> '' then
          ss.Add( layerTag );
      end;
    end;
    layersRect := IEView.LayersRect;
  end;

begin
  ss := TStringList.create;
  try
    if assigned( IEView ) and ( IEView is TImageEnVect ) and ( TImageEnVect( IEView ).ObjectsCount > 0 ) then
    begin
      // We are saving objects of a TImageEnVect. Convert them to TImageEnView layers

      iev := TImageEnView.create( nil );
      iev.LegacyBitmap := False;
      try
        // Clone the content of a TImageEnVect as layers
        iev.IEBitmap.Assign( TImageEnVect( IEView ).IEBitmap );
        TImageEnVect( IEView ).CopyAllObjectsTo( iev );
        _GetLayerSVG( iev );
      finally
        iev.Free;
      end;
    end
    else
    if assigned( IEView ) and ( IEView is TImageEnView ) then
    begin
      // We are saving Layers of a TImageEnView
      _GetLayerSVG( TImageEnView( IEView ));
    end
    else
    begin
      // Saving only a bitmap
      ss.Text := CreateSVGImageTag( Bitmap, ImageFormat, 0, 0, Bitmap.Width, Bitmap.Height );
      layersRect.X := 0;
      layersRect.Y := 0;
      layersRect.Width := Bitmap.Width;
      layersRect.Height :=  Bitmap.Height;
    end;

    if ss.Text = '' then
      xProgress.Aborting^ := true
    else
    begin
      commentBlock := format( 'Created with ImageEn %s - www.ImageEn.com', [ IEMAINVERSION ]);
      ss.Insert( 0, format( SVG_Opening_Tag, [ layersRect.Width, layersRect.Height, layersRect.X, layersRect.Y, layersRect.Width, layersRect.Height ]));
      ss.Insert( 1, format( XML_Comment_Block, [ commentBlock ]));

      ss.Add( SVG_Closing_Tag );

      if Stream <> nil  then
        ss.SaveToStream( Stream )
      else
        ss.SaveToFile( filename );
    end;
  finally
    ss.Free;
  end;
end;

end.