basic SVG export of vectorial layer

lazpaintcontrols/lcvectororiginal.pas

@@ -8,7 +8,8 @@ interface
 
 uses
   Classes, SysUtils, BGRABitmap, BGRALayerOriginal, fgl, BGRAGradientOriginal, BGRABitmapTypes,
-  BGRAPen, LCVectorialFill, LCResourceString;
+  BGRAPen, LCVectorialFill, LCResourceString, BGRASVGShapes, BGRASVGType,
+  BGRASVG, BGRAUnits;
 
 const
   InfiniteRect : TRect = (Left: -MaxLongInt; Top: -MaxLongInt; Right: MaxLongInt; Bottom: MaxLongInt);
@@ -252,11 +253,14 @@ type
     function GetPenVisibleNow: boolean;
     function GetBackVisible: boolean; virtual;
     function GetOutlineVisible: boolean; virtual;
+    procedure ApplyStrokeStyleToSVG(AElement: TSVGElement);
+    procedure ApplyFillStyleToSVG(AElement: TSVGElement);
     property Stroker: TBGRAPenStroker read GetStroker;
   public
     constructor Create(AContainer: TVectorOriginal); virtual;
     class function CreateFromStorage(AStorage: TBGRACustomOriginalStorage; AContainer: TVectorOriginal): TVectorShape;
     destructor Destroy; override;
+    function AppendToSVG(AContent: TSVGContent): TSVGElement; virtual; abstract;
     procedure BeginUpdate(ADiffHandler: TVectorShapeDiffAny=nil); virtual;
     procedure EndUpdate; virtual;
     procedure FillFit;
@@ -433,6 +437,7 @@ type
     constructor Create; override;
     destructor Destroy; override;
     procedure Clear;
+    function ConvertToSVG(out AOffset: TPoint): TObject; override;
     function AddTexture(ATexture: TBGRABitmap): integer;
     function GetTexture(AId: integer): TBGRABitmap;
     procedure DiscardUnusedTextures;
@@ -468,6 +473,7 @@ type
     procedure MoveShapeToIndex(AFromIndex, AToIndex: integer); overload;
     procedure MoveShapeToIndex(AFromIndex, AToIndex: array of integer); overload;
     class function StorageClassName: RawByteString; override;
+    class function CanConvertToSVG: boolean; override;
     property OnSelectShape: TVectorOriginalSelectShapeEvent read FOnSelectShape write FOnSelectShape;
     property SelectedShape: TVectorShape read FSelectedShape;
     property ShapeCount: integer read GetShapeCount;
@@ -1870,6 +1876,34 @@ begin
             (not (vsfOutlineWidth in Fields) or (OutlineWidth > 0));
 end;
 
+procedure TVectorShape.ApplyStrokeStyleToSVG(AElement: TSVGElement);
+var ps: array of single;
+  i: Integer;
+begin
+  if PenVisible then
+  begin
+    AElement.strokeColor := PenColor;
+    if IsSolidPenStyle(PenStyle) then
+      AElement.strokeDashArrayNone else
+      begin
+        setlength(ps, length(PenStyle));
+        for i := 0 to high(ps) do
+          ps[i] := PenStyle[i] * PenWidth;
+        AElement.strokeDashArrayF := ps;
+      end;
+    AElement.strokeLineJoinLCL := JoinStyle;
+    AElement.strokeWidth := FloatWithCSSUnit(PenWidth, cuCustom);
+  end else
+    AElement.strokeNone;
+end;
+
+procedure TVectorShape.ApplyFillStyleToSVG(AElement: TSVGElement);
+begin
+  if BackVisible then
+    AElement.fillColor := BackFill.AverageColor
+    else AElement.fillNone;
+end;
+
 procedure TVectorShape.TransformFill(const AMatrix: TAffineMatrix; ABackOnly: boolean);
 begin
   BeginUpdate;
@@ -2853,6 +2887,26 @@ begin
   end;
 end;
 
+function TVectorOriginal.ConvertToSVG(out AOffset: TPoint): TObject;
+var
+  svg: TBGRASVG;
+  rb: TRect;
+  vb: TSVGViewBox;
+  i: Integer;
+begin
+  svg := TBGRASVG.Create;
+  result := svg;
+  rb := GetRenderBounds(InfiniteRect, AffineMatrixIdentity);
+  svg.WidthAsPixel:= rb.Width;
+  svg.HeightAsPixel := rb.Height;
+  AOffset := rb.TopLeft;
+  vb.min := PointF(rb.Left, rb.Top);
+  vb.size := PointF(rb.Width, rb.Height);
+  svg.ViewBox := vb;
+  for i := 0 to ShapeCount-1 do
+    Shape[i].AppendToSVG(svg.Content);
+end;
+
 function TVectorOriginal.AddTexture(ATexture: TBGRABitmap): integer;
 begin
   result := GetTextureId(ATexture);
@@ -3637,6 +3691,11 @@ begin
   result := 'vector';
 end;
 
+class function TVectorOriginal.CanConvertToSVG: boolean;
+begin
+  result := true;
+end;
+
 initialization
 
   RegisterLayerOriginal(TVectorOriginal);

lazpaintcontrols/lcvectorpolyshapes.pas

@@ -7,7 +7,8 @@ interface
 
 uses
   Classes, SysUtils, Types, LCVectorOriginal, BGRABitmapTypes, BGRALayerOriginal,
-  BGRABitmap, BGRATransform, BGRAGradients, BGRAGraphics;
+  BGRABitmap, BGRATransform, BGRAGradients, BGRAGraphics,
+  BGRASVGShapes, BGRASVGType, BGRAUnits, BGRAPath;
 
 type
   TArrowKind = (akNone, akTail, akTip, akNormal, akCut, akFlipped, akFlippedCut,
@@ -90,6 +91,7 @@ type
     procedure OnMoveCenterPoint({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState);
     procedure OnStartMove({%H-}ASender: TObject; APointIndex: integer; {%H-}AShift: TShiftState);
     function GetCurve(AMatrix: TAffineMatrix): ArrayOfTPointF; virtual;
+    function GetPath(AMatrix: TAffineMatrix): TBGRAPath;
     procedure SetUsermode(AValue: TVectorShapeUsermode); override;
     function GetClosed: boolean; virtual;
     procedure SetClosed(AValue: boolean); virtual;
@@ -140,6 +142,7 @@ type
   public
     class function Fields: TVectorShapeFields; override;
     procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); overload; override;
+    function AppendToSVG(AContent: TSVGContent): TSVGElement; override;
     function GetRenderBounds({%H-}ADestRect: TRect; AMatrix: TAffineMatrix; AOptions: TRenderBoundsOptions = []): TRectF; override;
     function PointInShape(APoint: TPointF): boolean; overload; override;
     function PointInShape(APoint: TPointF; ARadius: single): boolean; overload; override;
@@ -202,7 +205,7 @@ procedure ApplyArrowStyle(AArrow: TBGRACustomArrow; AStart: boolean; AKind: TArr
 
 implementation
 
-uses BGRAPen, BGRAFillInfo, BGRAPath, math, LCVectorialFill,
+uses BGRAPen, BGRAFillInfo, math, LCVectorialFill,
   BGRAArrow, LCVectorRectShapes, LCResourceString;
 
 function StrToArrowKind(AStr: string): TArrowKind;
@@ -606,6 +609,11 @@ begin
     result[i] := m*Points[i];
 end;
 
+function TCustomPolypointShape.GetPath(AMatrix: TAffineMatrix): TBGRAPath;
+begin
+  result := TBGRAPath.Create(GetCurve(AMatrix));
+end;
+
 class function TCustomPolypointShape.Usermodes: TVectorShapeUsermodes;
 begin
   Result:= inherited Usermodes + [vsuCreate];
@@ -1216,6 +1224,19 @@ begin
   end;
 end;
 
+function TPolylineShape.AppendToSVG(AContent: TSVGContent): TSVGElement;
+var
+  p: TBGRAPath;
+begin
+  p := GetPath(AffineMatrixIdentity);
+  result := AContent.AppendPath(p.SvgString);
+  p.Free;
+  ApplyStrokeStyleToSVG(result);
+  if PenVisible then
+    result.strokeLineCapLCL := LineCap;
+  ApplyFillStyleToSVG(result);
+end;
+
 function TPolylineShape.GetRenderBounds(ADestRect: TRect; AMatrix: TAffineMatrix; AOptions: TRenderBoundsOptions): TRectF;
 var
   pts: ArrayOfTPointF;

lazpaintcontrols/lcvectorrectshapes.pas

@@ -7,7 +7,7 @@ interface
 
 uses
   Classes, SysUtils, Types, LCVectorOriginal, BGRABitmapTypes, BGRALayerOriginal,
-  BGRABitmap, BGRATransform, BGRAGradients;
+  BGRABitmap, BGRATransform, BGRAGradients, BGRASVGShapes, BGRASVGType, BGRAUnits;
 
 type
   TCustomRectShape = class;
@@ -100,6 +100,7 @@ type
     function GetCornerPositition: single; override;
   public
     class function Fields: TVectorShapeFields; override;
+    function AppendToSVG(AContent: TSVGContent): TSVGElement; override;
     procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); overload; override;
     function GetRenderBounds({%H-}ADestRect: TRect; AMatrix: TAffineMatrix; AOptions: TRenderBoundsOptions = []): TRectF; override;
     function PointInShape(APoint: TPointF): boolean; overload; override;
@@ -118,6 +119,7 @@ type
   public
     constructor Create(AContainer: TVectorOriginal); override;
     class function Fields: TVectorShapeFields; override;
+    function AppendToSVG(AContent: TSVGContent): TSVGElement; override;
     function GetAlignBounds(const {%H-}ALayoutRect: TRect; const AMatrix: TAffineMatrix): TRectF; override;
     procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); overload; override;
     function GetRenderBounds({%H-}ADestRect: TRect; AMatrix: TAffineMatrix; AOptions: TRenderBoundsOptions = []): TRectF; override;
@@ -179,6 +181,7 @@ type
     function GetCornerPositition: single; override;
     class function Fields: TVectorShapeFields; override;
     class function PreferPixelCentered: boolean; override;
+    function AppendToSVG(AContent: TSVGContent): TSVGElement; override;
     function GetAlignBounds(const ALayoutRect: TRect; const AMatrix: TAffineMatrix): TRectF; override;
     procedure ConfigureCustomEditor(AEditor: TBGRAOriginalEditor); override;
     procedure MouseDown(RightButton: boolean; Shift: TShiftState; X, Y: single; var ACursor: TOriginalEditorCursor; var AHandled: boolean); override;
@@ -927,6 +930,28 @@ begin
   Result:= [vsfPenFill, vsfPenWidth, vsfPenStyle, vsfJoinStyle, vsfBackFill];
 end;
 
+function TRectShape.AppendToSVG(AContent: TSVGContent): TSVGElement;
+var
+  topLeft, u, v: TPointF;
+  w, h: Single;
+begin
+  topLeft := Origin - (XAxis - Origin) - (YAxis - Origin);
+  w := Width*2; h := Height*2;
+  result := AContent.AppendRect(topLeft, PointF(w, h));
+  if (XAxis.y <> 0) or (YAxis.x <> 0) then
+  begin
+    u := XAxis - Origin;
+    if w > 0 then u *= (2/w);
+    v := YAxis - Origin;
+    if h > 0 then v *= (2/h);
+    result.Matrix[cuPixel] := AffineMatrixTranslation(topLeft.X, topLeft.Y) *
+                              AffineMatrix(u, v, PointF(0, 0)) *
+                              AffineMatrixTranslation(-topLeft.X, -topLeft.Y);
+  end;
+  ApplyStrokeStyleToSVG(result);
+  ApplyFillStyleToSVG(result);
+end;
+
 procedure TRectShape.Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix;
   ADraft: boolean);
 const GradientDithering = false;
@@ -1148,6 +1173,29 @@ begin
   Result:= [vsfPenFill, vsfPenWidth, vsfPenStyle, vsfBackFill];
 end;
 
+function TEllipseShape.AppendToSVG(AContent: TSVGContent): TSVGElement;
+var
+  u, v: TPointF;
+  rx, ry: Single;
+begin
+  rx := Width; ry := Height;
+  if rx <> ry then
+    result := AContent.AppendEllipse(Origin, PointF(rx, ry))
+    else result := AContent.AppendCircle(Origin, rx);
+  if (XAxis.y <> 0) or (YAxis.x <> 0) then
+  begin
+    u := XAxis - Origin;
+    if rx > 0 then u *= (1/rx);
+    v := YAxis - Origin;
+    if ry > 0 then v *= (1/ry);
+    result.matrix[cuPixel] := AffineMatrixTranslation(Origin.X, Origin.Y) *
+                              AffineMatrix(u, v, PointF(0, 0)) *
+                              AffineMatrixTranslation(-Origin.X, -Origin.Y);
+  end;
+  ApplyStrokeStyleToSVG(result);
+  ApplyFillStyleToSVG(result);
+end;
+
 function TEllipseShape.GetAlignBounds(const ALayoutRect: TRect;
   const AMatrix: TAffineMatrix): TRectF;
 var
@@ -1515,6 +1563,44 @@ begin
   Result:= false;
 end;
 
+function TPhongShape.AppendToSVG(AContent: TSVGContent): TSVGElement;
+var
+  u, v: TPointF;
+  rx, ry: Single;
+  p: TBGRAPath;
+begin
+  rx := Width; ry := Height;
+  case ShapeKind of
+    pskHalfSphere, pskConeTop:
+        if rx <> ry then
+          result := AContent.AppendEllipse(Origin, PointF(rx, ry))
+          else result := AContent.AppendCircle(Origin, rx);
+    pskConeSide: begin
+      p := TBGRAPath.Create;
+      p.moveTo(Origin.x, origin.y - ry);
+      p.lineTo(Origin.x + rx, Origin.y + ry);
+      p.lineTo(Origin.x - rx, Origin.y + ry);
+      result := AContent.AppendPath(p);
+      p.Free;
+    end
+    else {pskRectangle, pskRoundRectangle, pskHorizCylinder, pskVertCylinder}
+      result := AContent.AppendRect(Origin.x - rx, Origin.y - ry, rx*2, ry*2);
+  end;
+
+  if (XAxis.y <> 0) or (YAxis.x <> 0) then
+  begin
+    u := XAxis - Origin;
+    if rx > 0 then u *= (1/rx);
+    v := YAxis - Origin;
+    if ry > 0 then v *= (1/ry);
+    result.matrix[cuPixel] := AffineMatrixTranslation(Origin.X, Origin.Y) *
+                              AffineMatrix(u, v, PointF(0, 0)) *
+                              AffineMatrixTranslation(-Origin.X, -Origin.Y);
+  end;
+  result.strokeNone;
+  ApplyFillStyleToSVG(result);
+end;
+
 function TPhongShape.GetAlignBounds(const ALayoutRect: TRect;
   const AMatrix: TAffineMatrix): TRectF;
 var

lazpaintcontrols/lcvectortextshapes.pas

@@ -7,7 +7,8 @@ interface
 
 uses
   Classes, SysUtils, LCVectorRectShapes, BGRATextBidi, BGRABitmapTypes, LCVectorOriginal,
-  BGRAGraphics, BGRABitmap, BGRALayerOriginal, BGRACanvas2D, LCVectorialFill;
+  BGRAGraphics, BGRABitmap, BGRALayerOriginal, BGRACanvas2D, LCVectorialFill,
+  BGRASVGShapes, BGRASVGType, BGRAUnits;
 
 type
   TTextShape = class;
@@ -165,6 +166,7 @@ type
     class function CreateEmpty: boolean; override;
     class function StorageClassName: RawByteString; override;
     class function Usermodes: TVectorShapeUsermodes; override;
+    function AppendToSVG(AContent: TSVGContent): TSVGElement; override;
     procedure ConfigureCustomEditor(AEditor: TBGRAOriginalEditor); override;
     procedure Render(ADest: TBGRABitmap; ARenderOffset: TPoint; AMatrix: TAffineMatrix; ADraft: boolean); overload; override;
     function GetRenderBounds({%H-}ADestRect: TRect; AMatrix: TAffineMatrix; AOptions: TRenderBoundsOptions = []): TRectF; override;
@@ -2362,6 +2364,67 @@ begin
   Result:=inherited Usermodes + [vsuEditText];
 end;
 
+function TTextShape.AppendToSVG(AContent: TSVGContent): TSVGElement;
+var
+  topLeft, u, v: TPointF;
+  w, h, zoom: Single;
+  t: TSVGText;
+  tl: TBidiTextLayout;
+  i: Integer;
+  span: TSVGTSpan;
+  fm: TFontPixelMetric;
+  rF: TRectF;
+begin
+  topLeft := Origin - (XAxis - Origin) - (YAxis - Origin);
+  w := Width*2; h := Height*2;
+  result := AContent.AppendText(topLeft, '');
+  if (XAxis.y <> 0) or (YAxis.x <> 0) then
+  begin
+    u := XAxis - Origin;
+    if w > 0 then u *= (2/w);
+    v := YAxis - Origin;
+    if h > 0 then v *= (2/h);
+    result.matrix[cuPixel] := AffineMatrixTranslation(topLeft.X, topLeft.Y) *
+                              AffineMatrix(u, v, PointF(0, 0)) *
+                              AffineMatrixTranslation(-topLeft.X, -topLeft.Y);
+  end;
+  if PenVisible then
+    result.fillColor := PenColor
+    else result.fillNone;
+  if OutlineVisible then
+  begin
+    result.strokeColor := OutlineFill.AverageColor;
+    result.strokeWidth := FloatWithCSSUnit(OutlineWidth, cuCustom);
+    result.strokeLineJoinLCL:= pjsRound;
+  end else
+    result.strokeNone;
+  t := TSVGText(result);
+  t.fontStyleLCL:= FontStyle;
+  t.fontSize := FloatWithCSSUnit(FontEmHeight, cuPixel);
+  t.fontFamily:= FontName;
+  SetGlobalMatrix(AffineMatrixIdentity);
+  zoom := GetTextRenderZoom;
+  tl := GetTextLayout;
+  fm := tl.FontRenderer.GetFontPixelMetric;
+  for i := 0 to tl.PartCount-1 do
+  begin
+    rF := tl.PartRectF[i];
+    if rF.IsEmpty then continue;
+    rF.OffseT(topLeft.x, topLeft.y);
+    span := t.Content.AppendTextSpan(tl.GetTextPart(i, true));
+    if tl.PartRightToLeft[i] then
+      span.textDirection:= stdRtl
+      else span.textDirection:= stdLtr;
+    with rF do
+    begin
+      span.x := [FloatWithCSSUnit(Left/zoom, cuCustom)];
+      span.y := [FloatWithCSSUnit((Top + fm.Baseline)/zoom, cuCustom)];
+      span.textLength := FloatWithCSSUnit(Width/zoom, cuCustom);
+    end;
+  end;
+
+end;
+
 initialization
 
   RegisterVectorShape(TTextShape);