FastReport_2022_VCL/Source/frxSVGCanvas.pas

{******************************************}
{                                          }
{             FastReport VCL               }
{               SVG Canvas                 }
{                                          }
{         Copyright (c) 1998-2021          }
{            by Fast Reports Inc.          }
{                                          }
{******************************************}

unit frxSVGCanvas;

interface

{$I frx.inc}

uses
  Windows,
  Graphics,
  Classes,
  Types,
  frxSVGHelpers,
  frxSVGColor,
  frxSVGComponents;

type
  TSVGDashData = record
    Offset: Single;
    Arr: TSingleDynArray;
  end;

  TSVGStrokeData = record
    Width: Single;
    Miterlimit: Single;
    LineCap: TSVGSpecificWord;
    LineJoin: TSVGSpecificWord;
    Dash: TSVGDashData;
  end;

  TSVGFontData = record
    Names: string; // May be like "Georgia, 'Times New Roman', Times, serif"
    Size: Single;
    Style: TSVGSpecificWord;
    Weight: Integer;
    Decoration: TSVGSpecificWordSet;
  end;

  TSVGGradientStopData = record
    SVGColor: TSVGColor;
    Offset: Single;
  end;
  TSVGGradientArray = array of TSVGGradientStopData;

  TSVGDrawType = (dtFill, dtStroke);
  TSVGFillerType = (ftSolidColor, ftLinearGradient, ftRadialGradient, ftPattern);

  TSVGGradientData = record
    csu: TSVGSpecificWord;
    spreadMethod: TSVGSpecificWord;
    Bounds: TSingleBounds;
    Matrix: TSVGTransform;
    GradientArray: TSVGGradientArray;
    case FillerType: TSVGFillerType of
      ftLinearGradient: (x1, x2, y1, y2: Single);
      ftRadialGradient: (cx, cy, r, fx, fy, fr: Single);
  end;
//      cx, cy, r  defines the x|y-axis coordinate, radius of the end circle for a radial gradient.
//      fx, fy, fr defines the x|y-axis coordinate, radius of the focal point for a radial gradient

function IsSameSVGColor(F1, F2: TSVGColor): Boolean;
function IsSameGradient(G1, G2: TSVGGradientData): Boolean;
function ToSVGGradientStopData(SVGColor: TSVGColor; Offset: Single): TSVGGradientStopData;

const
  SVGColorBlack: TSVGColor = (R: 0; G: 0; B: 0; Alpha: 1.0);

type
  TSVGCanvasImage = class
  private
  public
    constructor Create(SA: TStreamAdapter); virtual; abstract;
    function GetWidth: Cardinal; virtual; abstract;
    function GetHeight: Cardinal; virtual; abstract;
  end;

  TSVGCanvasPath = class
  private
    FMatrix: TSVGTransform;
    FFillRule: TSVGSpecificWord;
  public
    constructor Create; virtual;
    function Clone: TSVGCanvasPath; virtual; abstract;
    procedure Transform(const Matrix: TSVGTransform); virtual; abstract;
    function Bounds: TSingleBounds; virtual; abstract;

    procedure AddArc(x, y, width, height, startAngle, sweepAngle: Single); virtual; abstract;

    procedure AddBezier(x1, y1, x2, y2, x3, y3, x4, y4: Single); overload; virtual; abstract;
    procedure AddBezier(p1, p2, p3, p4: TSinglePoint); overload;

    procedure AddCircle(cx, cy, r: Single); virtual; abstract;

    procedure AddEllipse(cx, cy, rx, ry: Single); virtual; abstract;

    procedure AddLine(x1, y1, x2, y2: Single); overload; virtual; abstract;
    procedure AddLine(p1, p2: TSinglePoint); overload;

    procedure AddPath(addingPath: TSVGCanvasPath; connect: Bool); virtual; abstract;

    procedure AddRectangle(x, y, width, height, rx, ry: Single); overload; virtual; abstract;
    procedure AddRectangle(Bounds: TSingleBounds; rx, ry: Single); overload;

    procedure CloseFigure; virtual; abstract;

    procedure StartFigure; virtual; abstract;

    function Log: string; virtual; abstract;

    property Matrix: TSVGTransform read FMatrix write FMatrix;
    property FillRule: TSVGSpecificWord read FFillRule write FFillRule;
  end;

  TSVGCanvasPathText = class
  protected
    FAdditionalMatrix: TSVGTransform;
  public
    function AddPathText(const Path: TSVGCanvasPath;
      const Text: string; const Indent: Single; FontData: TSVGFontData;
      const DistanceFactor: Single = 1; const KerningFactor: Single = 1): Single; virtual; abstract;


    property AdditionalMatrix: TSVGTransform read FAdditionalMatrix write FAdditionalMatrix;

  end;

  TTextDecoration = (tdUnderline, tdLineThrow, tdOwerline);
  TTextDecorations = array[TTextDecoration] of TSVGCanvasPath;

  TTextOrigin = record
    X, Y, DX, DY: TSingleDynArray;
  end;

  TSVGCanvasClass = class of TSVGCanvas;
  TSVGCanvas = class
  private
  protected
    FFillerType: array [TSVGDrawType] of TSVGFillerType;
    FSolidColorData: array [TSVGDrawType] of TSVGColor;
    FGradientData: array [TSVGDrawType] of TSVGGradientData;

    procedure ChangeSolidColorFiller(DrawType: TSVGDrawType); virtual; abstract;
    procedure ChangeLinearGradientFiller(DrawType: TSVGDrawType); virtual; abstract;
    procedure ChangeRadialGradientFiller(DrawType: TSVGDrawType); virtual; abstract;

    procedure StrokePath(Path: TSVGCanvasPath); virtual; abstract;
    procedure FillPath(Path: TSVGCanvasPath); virtual; abstract;
  public
    constructor Create(hdc: HDC); virtual; abstract;

    procedure SetTransform(const Matrix: TSVGTransform); virtual; abstract;
    procedure GetTransform(out Matrix: TSVGTransform); virtual; abstract;
    procedure ResetTransform; virtual; abstract;

    procedure SetSolidColor(DrawType: TSVGDrawType; SVGColor: TSVGColor);
    procedure SetGradient(DrawType: TSVGDrawType; GradientData: TSVGGradientData);

    procedure SetClip(Path: TSVGCanvasPath); virtual; abstract;
    procedure IntersectClip(Path: TSVGCanvasPath); virtual; abstract;
    procedure ResetClip; virtual; abstract;

    procedure SetStroke(StrokeData: TSVGStrokeData); virtual; abstract;

    procedure PaintPath(Path: TSVGCanvasPath; FillRule: TSVGSpecificWord);

    function MeasureString(st: string; FontData: TSVGFontData;
      out FontHeight: Single): TSingleSize; virtual; abstract;

    procedure DrawImage(FImage: TSVGCanvasImage; SVGRect: TSingleBounds; FillOpacity: Single); virtual; abstract;

    class procedure AddStringToPath(st: string; Path: TSVGCanvasPath; Decorations: TTextDecorations;
      TextOrigin: TTextOrigin; FontData: TSVGFontData); virtual;

    class function CreateImage(SA: TStreamAdapter): TSVGCanvasImage; virtual;
    class function CreatePath: TSVGCanvasPath; virtual;
    class function CreatePathText(Path: TSVGCanvasPath): TSVGCanvasPathText; virtual;
    class function GetPathLength(const Path: TSVGCanvasPath): Single; virtual;
  end;

implementation

uses
  Math;

{ Utility routines }

function IsSameGradientArray(A1, A2: TSVGGradientArray): Boolean;
var
  i: Integer;
begin
  Result := False;
    if Length(A1) <> Length(A2) then
      Exit
    else
      for i := 0 to High(A1) do
        if not IsSameSVGColor(A1[i].SVGColor, A2[i].SVGColor) or
           not IsSameSingle(A1[i].Offset, A2[i].Offset) then
          Exit;
  Result := True;
end;

function IsSameGradient(G1, G2: TSVGGradientData): Boolean;

  function IsSameLinearData: Boolean;
  begin
    Result := (G1.FillerType = ftLinearGradient) and
              (G2.FillerType = ftLinearGradient) and
              IsSameSingle(G1.x1, G2.x1) and
              IsSameSingle(G1.x2, G2.x2) and
              IsSameSingle(G1.y1, G2.y1) and
              IsSameSingle(G1.y2, G2.y2);
  end;

  function IsSameRadialData: Boolean;
  begin
    Result := (G1.FillerType = ftRadialGradient) and
              (G2.FillerType = ftRadialGradient) and
              IsSameSingle(G1.cx, G2.cx) and
              IsSameSingle(G1.cy, G2.cy) and
              IsSameSingle(G1.fr, G2.fr) and
              IsSameSingle(G1.fx, G2.fx) and
              IsSameSingle(G1.fy, G2.fy) and
              IsSameSingle(G1.r, G2.r);
  end;

begin
  Result := (IsSameLinearData or IsSameRadialData) and
            (G1.csu = G2.csu) and
            (G1.spreadMethod = G2.spreadMethod) and
            IsSameBounds(G1.Bounds, G2.Bounds) and
            IsSameTransform(G1.Matrix, G2.Matrix) and
            IsSameGradientArray(G1.GradientArray, G2.GradientArray);
end;

function IsSameSVGColor(F1, F2: TSVGColor): Boolean;
begin
  Result := (F1.R = F2.R) and (F1.G = F2.G) and (F1.B = F2.B) and IsSameSingle(F1.Alpha, F2.Alpha);
end;

function ToSVGGradientStopData(SVGColor: TSVGColor; Offset: Single): TSVGGradientStopData;
begin
  Result.SVGColor := SVGColor;
  Result.Offset := Offset;
end;

{ TSVGGPGraphicsPath }

procedure TSVGCanvasPath.AddBezier(p1, p2, p3, p4: TSinglePoint);
begin
  AddBezier(p1.X, p1.Y, p2.X, p2.Y, p3.X, p3.Y, p4.X, p4.Y);
end;

procedure TSVGCanvasPath.AddLine(p1, p2: TSinglePoint);
begin
  AddLine(p1.X, p1.Y, p2.X, p2.Y);
end;

procedure TSVGCanvasPath.AddRectangle(Bounds: TSingleBounds; rx, ry: Single);
begin
  with Bounds do
    AddRectangle(x, y, width, height, rx, ry);
end;

constructor TSVGCanvasPath.Create;
begin
  Matrix := tmIdentity;
end;

{ TSVGCanvas }

class procedure TSVGCanvas.AddStringToPath(st: string; Path: TSVGCanvasPath;
  Decorations: TTextDecorations; TextOrigin: TTextOrigin;
  FontData: TSVGFontData);
begin
// !! raise
end;

class function TSVGCanvas.CreateImage(SA: TStreamAdapter): TSVGCanvasImage;
begin
// !! raise
  Result := nil;
end;

class function TSVGCanvas.CreatePath: TSVGCanvasPath;
begin
// !! raise
  Result := nil;
end;

class function TSVGCanvas.CreatePathText(
  Path: TSVGCanvasPath): TSVGCanvasPathText;
begin
// !! raise
  Result := nil;
end;

class function TSVGCanvas.GetPathLength(const Path: TSVGCanvasPath): Single;
begin
// !! raise
  Result := 0;
end;

procedure TSVGCanvas.PaintPath(Path: TSVGCanvasPath; FillRule: TSVGSpecificWord);
begin
  if Path <> nil then
  begin
    Path.FillRule := FillRule;
    FillPath(Path);
    StrokePath(Path);
  end;
end;

procedure TSVGCanvas.SetGradient(DrawType: TSVGDrawType; GradientData: TSVGGradientData);
begin
  FFillerType[DrawType] := GradientData.FillerType;
  if not IsSameGradient(FGradientData[DrawType], GradientData) then
  begin
    FGradientData[DrawType] := GradientData;
    with FGradientData[DrawType] do
    begin
      SetLength(GradientArray, Length(GradientData.GradientArray));
      Move(GradientData.GradientArray[0], GradientArray[0], SizeOf(GradientArray[0]) * Length(GradientArray));
    end;

    case FFillerType[DrawType] of
      ftLinearGradient: ChangeLinearGradientFiller(DrawType);
      ftRadialGradient: ChangeRadialGradientFiller(DrawType);
    end;
  end;
end;

procedure TSVGCanvas.SetSolidColor(DrawType: TSVGDrawType; SVGColor: TSVGColor);
begin
  FFillerType[DrawType] := ftSolidColor;
  if not IsSameSVGColor(FSolidColorData[DrawType], SVGColor) then
  begin
    FSolidColorData[DrawType] := SVGColor;
    ChangeSolidColorFiller(DrawType);
  end;
end;

end.