Signature to SVG with Skia4Delphi

Sample.Form.Controls.TSkPaintBox.pas

{************************************************************************}
{                                                                        }
{                              Skia4Delphi                               }
{                                                                        }
{ Copyright (c) 2011-2022 Google LLC.                                    }
{ Copyright (c) 2021-2022 Skia4Delphi Project.                           }
{                                                                        }
{ Use of this source code is governed by a BSD-style license that can be }
{ found in the LICENSE file.                                             }
{                                                                        }
{************************************************************************}
unit Sample.Form.Controls.TSkPaintBox;

// This is a modified unit from the Skia4Delphi demo
// https://github.com/skia4delphi/skia4delphi/blob/main/Samples/Demo/FMX/Source/Sample.Form.Controls.TSkPaintBox.pas
// which adds SVG property to IFreehand

interface

{$SCOPEDENUMS ON}

uses
  { Delphi }
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Math.Vectors, FMX.Types, FMX.Controls, FMX.Forms, FMX.StdCtrls,
  FMX.Layouts, FMX.Objects,

  { Skia }
  Skia, Skia.FMX,

  { Sample }
  Sample.Form.Base;

type
  TfrmTSkPaintBox = class(TfrmBase)
    btnSweepGradient: TSpeedButton;
    lblSweepGradientTitle: TSkLabel;
    lblSweepGradientDescription: TSkLabel;
    btnFreehand: TSpeedButton;
    lblFreehandTitle: TSkLabel;
    lblFreehandDescription: TSkLabel;
    lytContentTopOffset: TLayout;
    procedure btnFreehandClick(Sender: TObject);
    procedure btnSweepGradientClick(Sender: TObject);
  private
    procedure OnSweepGradientDraw(ASender: TObject; const ACanvas: ISkCanvas; const ADest: TRectF; const AOpacity: Single);
  public
    { Public declarations }
  end;

implementation

uses
  { Sample }
  Sample.Form.Viewer.Control;

{$R *.fmx}

type
  IFreehandRender = interface
    function GetSVG: string;
    procedure SetSVG(const AValue: string; const ADrawArea: TRectF);
    property SVG: string read GetSVG;
  end;

  TFreehandRender = class(TInterfacedObject, IFreehandRender)
  strict private
    FCurrentPath: ISkPath;
    FLastPoint: TPointF;
    FLastSVG: string;
    FOldPaths: TArray<ISkPath>;
    FPathBuilder: ISkPathBuilder;
    FPressed: Boolean;
    function GetPaint: ISkPaint;
    function GetSVG: string;
  public
    procedure OnDraw(ASender: TObject; const ACanvas: ISkCanvas; const ADest: TRectF; const AOpacity: Single);
    procedure OnMouseDown(ASender: TObject; AButton: TMouseButton; AShift: TShiftState; X, Y: Single);
    procedure OnMouseLeave(ASender: TObject);
    procedure OnMouseMove(ASender: TObject; AShift: TShiftState; X, Y: Single);
    procedure OnMouseUp(ASender: TObject; AButton: TMouseButton; AShift: TShiftState; X, Y: Single);
    procedure SetSVG(const AValue: string; const ADrawArea: TRectF);
    property SVG: string read GetSVG;
  end;

var
  FFreehandRender: IFreehandRender;

{ TfrmTSkPaintBox }

procedure TfrmTSkPaintBox.btnFreehandClick(Sender: TObject);
begin
  FFreehandRender := TFreehandRender.Create;
  ChildForm<TfrmControlViewer>.Show('Freehand / Signature', 'Touch or click in screen and move to draw',
    function (): TControl
    var
      LPaintBox: TSkPaintBox absolute Result;
    begin
      LPaintBox := TSkPaintBox.Create(nil);
      LPaintBox.Align := TAlignLayout.Client;
      LPaintBox.HitTest := True;
      LPaintBox.AutoCapture := True;
      LPaintBox.OnDraw := TFreehandRender(FFreehandRender).OnDraw;
      LPaintBox.OnMouseDown := TFreehandRender(FFreehandRender).OnMouseDown;
      LPaintBox.OnMouseMove := TFreehandRender(FFreehandRender).OnMouseMove;
      LPaintBox.OnMouseUp := TFreehandRender(FFreehandRender).OnMouseUp;
      LPaintBox.OnMouseLeave := TFreehandRender(FFreehandRender).OnMouseLeave;
    end);
end;

procedure TfrmTSkPaintBox.btnSweepGradientClick(Sender: TObject);
begin
  ChildForm<TfrmControlViewer>.Show('Sweep Gradient', '',
    function (): TControl
    var
      LPaintBox: TSkPaintBox absolute Result;
    begin
      LPaintBox := TSkPaintBox.Create(nil);
      LPaintBox.Align := TAlignLayout.Client;
      LPaintBox.OnDraw := OnSweepGradientDraw;
    end);
end;

procedure TfrmTSkPaintBox.OnSweepGradientDraw(ASender: TObject;
  const ACanvas: ISkCanvas; const ADest: TRectF; const AOpacity: Single);
var
  LPaint: ISkPaint;
begin
  LPaint := TSkPaint.Create;
  LPaint.Shader := TSkShader.MakeGradientSweep(ADest.CenterPoint, [$FFFCE68D, $FFF7CAA5, $FF2EBBC1, $FFFCE68D]);
  ACanvas.DrawPaint(LPaint);
end;

{ TFreehandRender }

function TFreehandRender.GetPaint: ISkPaint;
begin
  Result := TSkPaint.Create(TSkPaintStyle.Stroke);
  Result.AntiAlias := True;
  Result.Color := TAlphaColors.Royalblue;
  Result.SetPathEffect(TSkPathEffect.MakeCorner(50));
  Result.StrokeCap := TSkStrokeCap.Round;
  Result.StrokeWidth := 4;
end;

function TFreehandRender.GetSVG: string;

  function JoinPaths: ISkPath;
  var
    LPath: ISkPath;
    LPathBuilder: ISkPathBuilder;
  begin
    if Assigned(FPathBuilder) or Assigned(FOldPaths) then
    begin
      LPathBuilder := TSkPathBuilder.Create;
      if Assigned(FPathBuilder) and not Assigned(FCurrentPath) then
        FCurrentPath := FPathBuilder.Snapshot;
      if Assigned(FCurrentPath) then
        LPathBuilder.AddPath(FCurrentPath);
      for LPath in FOldPaths do
        LPathBuilder.AddPath(LPath);
      Result := LPathBuilder.Detach;
    end
    else
      Result := nil;
  end;

  function GenerateSVG: string;
  var
    LJoinedPaths: ISkPath;
    LPaint: ISkPaint;
    LPathsBounds: TRectF;
  begin
    LJoinedPaths := JoinPaths;
    if Assigned(LJoinedPaths) then
    begin
      LPaint := GetPaint;
      LJoinedPaths := LPaint.GetFillPath(LJoinedPaths);
      LPathsBounds := LJoinedPaths.Bounds;
      LJoinedPaths := LJoinedPaths.Transform(TMatrix.CreateTranslation(-LPathsBounds.Left, -LPathsBounds.Top));
      Result := LJoinedPaths.ToSVG;
      if not Result.IsEmpty then
      begin
        LPathsBounds := LJoinedPaths.Bounds;
        Result := Format('<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 %s %s" fill="#%s"><path id="sinature-path" d="%s"/></svg>',
          [LPathsBounds.Right.ToString(TFormatSettings.Invariant), LPathsBounds.Bottom.ToString(TFormatSettings.Invariant),
          InttoHex(LPaint.Color and not TAlphaColors.Alpha, 6).ToLower, Result]);
      end;
    end;
  end;

begin
  if FLastSVG.IsEmpty then
    FLastSVG := GenerateSVG;
  Result := FLastSVG;
end;

procedure TFreehandRender.OnDraw(ASender: TObject; const ACanvas: ISkCanvas;
  const ADest: TRectF; const AOpacity: Single);
var
  LPaint: ISkPaint;
  LPath: ISkPath;
begin
  ACanvas.Save;
  try
    ACanvas.ClipRect(ADest);
    LPaint := GetPaint;
    for LPath in FOldPaths do
      ACanvas.DrawPath(LPath, LPaint);
    if Assigned(FPathBuilder) and not Assigned(FCurrentPath) then
      FCurrentPath := FPathBuilder.Snapshot;
    if Assigned(FCurrentPath) then
      ACanvas.DrawPath(FCurrentPath, LPaint);
  finally
    ACanvas.Restore;
  end;
end;

procedure TFreehandRender.OnMouseDown(ASender: TObject; AButton: TMouseButton;
  AShift: TShiftState; X, Y: Single);
begin
  FPressed := True;
  FPathBuilder := TSkPathBuilder.Create;
  FPathBuilder.MoveTo(X, Y);
  FLastPoint := PointF(X, Y);
  FCurrentPath := nil;
end;

procedure TFreehandRender.OnMouseLeave(ASender: TObject);
begin
  if Assigned(FPathBuilder) then
  begin
    if FCurrentPath = nil then
      FCurrentPath := FPathBuilder.Snapshot;
    FOldPaths := FOldPaths + [FCurrentPath];
    FPathBuilder := nil;
    FCurrentPath := nil;
    FLastSVG := '';
  end;
end;

procedure TFreehandRender.OnMouseMove(ASender: TObject; AShift: TShiftState; X,
  Y: Single);
const
  MinPointsDistance = 5;
begin
  if FPressed and Assigned(FPathBuilder) and (FLastPoint.Distance(PointF(X, Y)) >= MinPointsDistance) then
  begin
    FCurrentPath := nil;
    FPathBuilder.LineTo(X, Y);
    FLastPoint := PointF(X, Y);
    FLastSVG := '';
    (ASender as TSkPaintBox).Redraw;
  end;
end;

procedure TFreehandRender.OnMouseUp(ASender: TObject; AButton: TMouseButton;
  AShift: TShiftState; X, Y: Single);
begin
  OnMouseLeave(ASender);
end;

procedure TFreehandRender.SetSVG(const AValue: string; const ADrawArea: TRectF);

  function TryGetSvgPath(out ASvgPath: ISkPath): Boolean;
  var
    LStrings: TArray<string>;
  begin
    Result := False;
    LStrings := AValue.Split(['<path id="sinature-path" d="']);
    if Length(LStrings) = 2 then
    begin
      LStrings := LStrings[1].Split(['"/>'], TStringSplitOptions.ExcludeEmpty);
      if Length(LStrings) > 0 then
      begin
        ASvgPath := TSkPath.Create(LStrings[0]);
        Result := Assigned(ASvgPath);
        if Result then
        begin
          ASvgPath := ASvgPath.Transform(TMatrix.CreateTranslation((ASvgPath.Bounds.Width - ADrawArea.Width) / 2,
            (ASvgPath.Bounds.Height - ADrawArea.Height) / 2));
        end;
      end;
    end;
  end;

var
  LSvgPath: ISkPath;
begin
  if AValue.IsEmpty or not TryGetSvgPath(LSvgPath) then
  begin
    FOldPaths := nil;
    FLastSVG := '';
  end
  else
  begin
    FOldPaths := [LSvgPath];
    FLastSVG := AValue;
  end;
  FPathBuilder := nil;
  FCurrentPath := nil;
end;

end.