Browse Source

added demo for lcl TSkPaintBox

mattias 1 year ago
parent
commit
2c854e84fd

+ 1 - 0
demo/LCLSkiaPaintBox/.gitignore

@@ -0,0 +1 @@
+lclskiapaintcontrol1

+ 832 - 0
demo/LCLSkiaPaintBox/LCL.Skia.pas

@@ -0,0 +1,832 @@
+unit LCL.Skia;
+
+{$Mode ObjFPC}{$H+}
+{$ScopedEnums On}
+
+interface
+
+uses
+  Classes, SysUtils, Math, Types, System.UITypes, Controls, IntfGraphics,
+  Graphics, LCLIntf, GraphType, System.Skia, SkiaFPC;
+
+type
+  ESkLcl = class(Exception);
+
+  TSkTextHorzAlign = (Center, Leading, Trailing, Justify);
+  TSkTextVertAlign = (Center, Leading, Trailing);
+  TSkTextTrimming = (None, Character, Word);
+  TSkStyledSetting = (Family, Size, Style, FontColor, Other);
+  TSkStyledSettings = set of TSkStyledSetting;
+
+  TSkDrawEvent = procedure(Sender: TObject; const aCanvas: ISkCanvas;
+                           const aDest: TRectF; const aOpacity: Single) of object;
+  TSkDrawCacheKind = (Never, Raster, Always);
+
+  { TSkCustomControl }
+
+  TSkCustomControl = class (TGraphicControl)
+  private
+    FDrawCached: Boolean;
+    FDrawCacheKind: TSkDrawCacheKind;
+    FIntfImg: TLazIntfImage;
+    FOnDraw: TSkDrawEvent;
+    FOpacity: Byte;
+    procedure SetDrawCacheKind(const AValue: TSkDrawCacheKind);
+    procedure SetOnDraw(const AValue: TSkDrawEvent);
+    procedure SetOpacity(const AValue: Byte);
+  protected
+    FScaleFactor: Single;
+    procedure ChangeScale(Multiplier, Divider: Integer); override;
+    procedure Draw(const aCanvas: ISkCanvas; const aDest: TRectF; const aOpacity: Single); virtual;
+    procedure DeleteBuffers; virtual;
+    function NeedsRedraw: Boolean; virtual;
+    procedure Paint; override;
+    procedure Resize; override;
+    property DrawCacheKind: TSkDrawCacheKind read FDrawCacheKind write SetDrawCacheKind default TSkDrawCacheKind.Raster;
+    property OnDraw: TSkDrawEvent read FOnDraw write SetOnDraw;
+  public
+    class function GetControlClassDefaultSize: TSize; override;
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Redraw; virtual;
+    property Opacity: Byte read FOpacity write SetOpacity default 255;
+    property ScaleFactor: Single read FScaleFactor;
+  end;
+
+  { TSkPaintBox }
+
+  TSkPaintBox = class(TSkCustomControl)
+  public
+    property DrawCacheKind;
+  published
+    property Align;
+    property Anchors;
+    property BorderSpacing;
+    property Color;
+    property Constraints;
+    property DragCursor;
+    property DragMode;
+    property Enabled;
+    property Font;
+    property Hint;
+    property ParentColor;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property ShowHint;
+    property Visible;
+    property OnChangeBounds;
+    property OnClick;
+    property OnContextPopup;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnDraw;
+    property OnEndDrag;
+    property OnMouseDown;
+    property OnMouseEnter;
+    property OnMouseLeave;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnMouseWheelHorz;
+    property OnMouseWheelLeft;
+    property OnMouseWheelRight;
+    property OnPaint;
+    property OnResize;
+    property OnStartDrag;
+  end;
+
+  TSkSvgSource = type string;
+  TSkSvgWrapMode = (Default, Fit, FitCrop, Original, OriginalCenter, Place, Stretch, Tile);
+
+  { TSkSvgBrush }
+
+  TSkSvgBrush = class(TPersistent)
+  strict private const
+    DefaultGrayScale = False;
+    DefaultWrapMode = TSkSvgWrapMode.Fit;
+  strict private
+    FDOM: ISkSVGDOM;
+    FGrayScale: Boolean;
+    FOnChanged: TNotifyEvent;
+    FOriginalSize: TSizeF;
+    FOverrideColor: TAlphaColor;
+    FSource: TSkSvgSource;
+    FWrapMode: TSkSvgWrapMode;
+    function GetDOM: ISkSVGDOM;
+    function GetOriginalSize: TSizeF;
+    procedure SetGrayScale(const AValue: Boolean);
+    procedure SetOverrideColor(const AValue: TAlphaColor);
+    procedure SetSource(const AValue: TSkSvgSource);
+    procedure SetWrapMode(const AValue: TSkSvgWrapMode);
+  strict protected
+    procedure DoAssign(ASource: TSkSvgBrush); virtual;
+    procedure DoChanged; virtual;
+    function HasContent: Boolean; virtual;
+    function MakeDOM: ISkSVGDOM; virtual;
+    procedure RecreateDOM;
+  public
+    constructor Create;
+    procedure Assign(ASource: TPersistent); override;
+    function Equals(AObject: TObject): Boolean; override;
+    procedure Render(const ACanvas: ISkCanvas; const ADestRect: TRectF; const AOpacity: Single);
+    property DOM: ISkSVGDOM read GetDOM;
+    property OriginalSize: TSizeF read GetOriginalSize;
+    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
+  published
+    property GrayScale: Boolean read FGrayScale write SetGrayScale default DefaultGrayScale;
+    property OverrideColor: TAlphaColor read FOverrideColor write SetOverrideColor;
+    property Source: TSkSvgSource read FSource write SetSource;
+    property WrapMode: TSkSvgWrapMode read FWrapMode write SetWrapMode default DefaultWrapMode;
+  end;
+
+  { TSkSvg }
+
+  TSkSvg = class(TSkCustomControl)
+  strict private
+    FSvg: TSkSvgBrush;
+    procedure SetSvg(const AValue: TSkSvgBrush);
+    procedure SvgChanged({%H-}ASender: TObject);
+  strict protected
+    function CreateSvgBrush: TSkSvgBrush; virtual;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Draw(const ACanvas: ISkCanvas; const ADest: TRectF; const AOpacity: Single); override;
+  published
+    property Svg: TSkSvgBrush read FSvg write SetSvg;
+    property OnDraw;
+  end;
+
+  TSkControlRenderBackend = (Default, Raster, HardwareAcceleration);
+
+  { ISkControlRenderTarget }
+
+  ISkControlRenderTarget = interface
+    ['{DBEF2E70-E032-4B70-BDF9-C3DCAED502C7}']
+    procedure Draw(const ACanvas: ISkCanvas; const ADest: TRectF; const AOpacity: Single);
+    function GetCanvas: TCanvas;
+    //function GetDeviceContext(var WindowHandle: HWND): HDC;
+    function GetDrawCacheKind: TSkDrawCacheKind;
+    function GetHeight: Integer;
+    function GetScaleFactor: Single;
+    function GetWidth: Integer;
+    property Canvas: TCanvas read GetCanvas;
+    property DrawCacheKind: TSkDrawCacheKind read GetDrawCacheKind;
+    property Height: Integer read GetHeight;
+    property ScaleFactor: Single read GetScaleFactor;
+    property Width: Integer read GetWidth;
+  end;
+
+  { ISkControlRender }
+
+  ISkControlRender = interface
+    ['{6ACA5428-9554-4CB8-8644-4D796B9D8333}']
+    procedure Redraw;
+    procedure Resized;
+    function TryRender(const ABackgroundBuffer: TBitmap; const AOpacity: Byte): Boolean;
+  end;
+
+  { TSkControlRender }
+
+  TSkControlRender = class abstract(TInterfacedObject)
+  public
+    class function MakeRender(const ATarget: ISkControlRenderTarget; const ABackend: TSkControlRenderBackend): ISkControlRender; static;
+  end;
+
+  { TSkDefaultProviders }
+
+  TSkDefaultProviders = class
+  strict private class var
+    FResource: ISkResourceProvider;
+    FTypefaceFont: ISkTypefaceFontProvider;
+    class constructor Create;
+  public
+    class procedure RegisterTypeface(const AFileName: string); overload; static;
+    class procedure RegisterTypeface(const AStream: TStream); overload; static;
+    class property Resource: ISkResourceProvider read FResource write FResource;
+    class property TypefaceFont: ISkTypefaceFontProvider read FTypefaceFont;
+  end;
+
+function BitmapToSkImage(const ABitmap: TBitmap): ISkImage;
+procedure DrawDesignBorder(const ACanvas: ISkCanvas; ADest: TRectF; const AOpacity: Single);
+//procedure SkiaDraw(const ABitmap: TBitmap; const AProc: TSkDrawProc; const AStartClean: Boolean = True);
+function SkImageToBitmap(const AImage: ISkImage): TBitmap;
+
+const
+  AllStyledSettings: TSkStyledSettings = [TSkStyledSetting.Family, TSkStyledSetting.Size,
+    TSkStyledSetting.Style, TSkStyledSetting.FontColor, TSkStyledSetting.Other];
+  DefaultStyledSettings: TSkStyledSettings = [TSkStyledSetting.Family, TSkStyledSetting.Size,
+    TSkStyledSetting.Style, TSkStyledSetting.FontColor];
+
+implementation
+
+procedure FlipPixelsVertically(IntfImg: TLazIntfImage);
+var
+  I, J, Height: Integer;
+  Stride: PtrUInt;
+  Row, Pixels: PByte;
+begin
+  Stride:=IntfImg.DataDescription.BytesPerLine;
+  Row:=GetMem(Stride);
+  try
+    Pixels:=IntfImg.PixelData;
+    Height:=IntfImg.Height;
+    for I := 0 to Height div 2 -1 do
+    begin
+      J:=Height-I-1;
+      Move(Pixels[I * Stride], Row^, Stride);
+      Move(Pixels[J * Stride], Pixels[I * Stride], Stride);
+      Move(Row^, Pixels[J * Stride], Stride);
+    end;
+  finally
+    FreeMem(Row);
+  end;
+end;
+
+procedure BitmapToSkImage_Release(const APixels: Pointer);
+begin
+  FreeMem(APixels);
+end;
+
+function BitmapToSkImage(const ABitmap: TBitmap): ISkImage;
+var
+  IntfImg: TLazIntfImage;
+  LAlphaType: TSkAlphaType;
+  LStream: TMemoryStream;
+  Height: Integer;
+begin
+  if ABitmap.Empty then
+    raise ESkLcl.Create('Invalid bitmap');
+
+  if ABitmap.PixelFormat = TPixelFormat.pf32bit then
+  begin
+    IntfImg:=ABitmap.CreateIntfImage;
+    try
+      Height:=IntfImg.Height;
+      //case ABitmap.AlphaFormat of
+      //  TAlphaFormat.afIgnored: LAlphaType := TSkAlphaType.Opaque;
+      //  TAlphaFormat.afDefined: LAlphaType := TSkAlphaType.Unpremul;
+      //  TAlphaFormat.afPremultiplied: LAlphaType := TSkAlphaType.Premul;
+      //else
+        LAlphaType := TSkAlphaType.Unknown;
+      //end;
+      if IntfImg.DataDescription.LineOrder=riloTopToBottom then
+        FlipPixelsVertically(IntfImg);
+      Result := TSkImage.MakeFromRaster(
+          TSkImageInfo.Create(IntfImg.Width, Height, SkNative32ColorType, LAlphaType),
+          IntfImg.PixelData,
+          IntfImg.DataDescription.BytesPerLine,
+          @BitmapToSkImage_Release);
+    finally
+      IntfImg.Free;
+    end;
+  end
+  else begin
+    LStream := TMemoryStream.Create;
+    try
+      ABitmap.SaveToStream(LStream);
+      LStream.Position := 0;
+      Result := TSkImage.MakeFromEncodedStream(LStream);
+    finally
+      LStream.Free;
+    end;
+  end;
+end;
+
+procedure DrawDesignBorder(const ACanvas: ISkCanvas; ADest: TRectF;
+  const AOpacity: Single);
+const
+  DesignBorderColor = $A0909090;
+var
+  LPaint: ISkPaint;
+begin
+  LPaint := TSkPaint.Create(TSkPaintStyle.Stroke);
+  LPaint.AlphaF := AOpacity;
+  LPaint.Color := DesignBorderColor;
+  LPaint.StrokeWidth := 1;
+  LPaint.PathEffect := TSkPathEffect.MakeDash([3, 1], 0);
+
+  ADest.Inflate(-0.5, -0.5);
+  ACanvas.DrawRect(ADest, LPaint);
+end;
+
+function SkImageToBitmap(const AImage: ISkImage): TBitmap;
+var
+  IntfImg: TLazIntfImage;
+begin
+  Assert(Assigned(AImage));
+  Result:=TBitMap.Create;
+  Result.PixelFormat := TPixelFormat.pf32bit;
+  //Result.AlphaFormat := TAlphaFormat.afPremultiplied;
+  if (AImage.Width=0) and (AImage.Height=0) then exit;
+
+  IntfImg:=TLazIntfImage.Create(0,0);
+  try
+    if SkNative32ColorType=TSkColorType.BGRA8888 then
+      IntfImg.DataDescription.Init_BPP32_B8G8R8A8_BIO_TTB(AImage.Width,AImage.Height)
+    else
+      IntfImg.DataDescription.Init_BPP32_A8R8G8B8_BIO_TTB(AImage.Width,AImage.Height);
+
+    AImage.ReadPixels(TSkImageInfo.Create(AImage.Width, AImage.Height),
+                      IntfImg.PixelData, IntfImg.DataDescription.BytesPerLine);
+    FlipPixelsVertically(IntfImg);
+
+    Result.LoadFromIntfImage(IntfImg);
+  finally
+    IntfImg.Free;
+  end;
+end;
+
+function PlaceIntoTopLeft(const ASourceRect, ADesignatedArea: TRectF): TRectF;
+begin
+  Result := ASourceRect;
+  if (ASourceRect.Width > ADesignatedArea.Width) or (ASourceRect.Height > ADesignatedArea.Height) then
+    Result := Result.FitInto(ADesignatedArea);
+  Result.SetLocation(ADesignatedArea.TopLeft);
+end;
+
+{ TSkCustomControl }
+
+procedure TSkCustomControl.SetOpacity(const AValue: Byte);
+begin
+  if FOpacity=AValue then Exit;
+  FOpacity:=AValue;
+  Invalidate;
+end;
+
+procedure TSkCustomControl.ChangeScale(Multiplier, Divider: Integer);
+begin
+  if Multiplier <> Divider then
+    FScaleFactor := FScaleFactor * Multiplier / Divider;
+  inherited ChangeScale(Multiplier, Divider);
+end;
+
+procedure TSkCustomControl.SetOnDraw(const AValue: TSkDrawEvent);
+begin
+  if FOnDraw=AValue then Exit;
+  FOnDraw:=AValue;
+  Invalidate;
+end;
+
+procedure TSkCustomControl.SetDrawCacheKind(const AValue: TSkDrawCacheKind);
+begin
+  if FDrawCacheKind=AValue then Exit;
+  FDrawCacheKind:=AValue;
+  if FDrawCacheKind <> TSkDrawCacheKind.Always then
+    Invalidate;
+end;
+
+procedure TSkCustomControl.Draw(const aCanvas: ISkCanvas; const aDest: TRectF;
+  const aOpacity: Single);
+begin
+  if csDesigning in ComponentState then
+    DrawDesignBorder(ACanvas, ADest, AOpacity);
+end;
+
+procedure TSkCustomControl.DeleteBuffers;
+begin
+  if FIntfImg<>nil then
+  begin
+    FDrawCached := False;
+    FreeAndNil(FIntfImg);
+  end;
+end;
+
+function TSkCustomControl.NeedsRedraw: Boolean;
+begin
+  Result := (not FDrawCached)
+         or (FDrawCacheKind = TSkDrawCacheKind.Never)
+         or (FIntfImg = nil);
+end;
+
+procedure TSkCustomControl.Paint;
+
+  procedure InternalDraw;
+  var
+    LSurface: ISkSurface;
+    LDestRect: TRectF;
+  begin
+    LSurface := TSkSurface.MakeRasterDirect(TSkImageInfo.Create(Width, Height),
+                     FIntfImg.PixelData, FIntfImg.DataDescription.BytesPerLine);
+    LSurface.Canvas.Clear(TAlphaColors.Null);
+    LSurface.Canvas.Concat(TMatrix.CreateScaling(ScaleFactor, ScaleFactor));
+    LDestRect := RectF(0, 0, Single(Width) / ScaleFactor, Single(Height) / ScaleFactor);
+    Draw(LSurface.Canvas, LDestRect, 1);
+    if Assigned(OnDraw) then
+      OnDraw(Self, LSurface.Canvas, LDestRect, 1);
+    FDrawCached := True;
+  end;
+
+var
+  Desc: TRawImageDescription;
+  Bmp: TBitmap;
+begin
+  if (Width <= 0) or (Height <= 0) then
+    Exit;
+
+  if FIntfImg=nil then
+  begin
+    if SkNative32ColorType=TSkColorType.BGRA8888 then
+      Desc.Init_BPP32_B8G8R8A8_BIO_TTB(Width, Height)
+    else
+      Desc.Init_BPP32_R8G8B8A8_BIO_TTB(Width, Height);
+    FIntfImg:=TLazIntfImage.Create(0,0);
+    FIntfImg.DataDescription:=Desc;
+    FIntfImg.SetSize(Width,Height);
+  end;
+
+  if NeedsRedraw then
+    InternalDraw;
+
+  Bmp:=TBitmap.Create;
+  try
+    Bmp.LoadFromIntfImage(FIntfImg);
+    Canvas.Draw(0,0,Bmp);
+  finally
+    Bmp.Free;
+  end;
+
+  inherited Paint;
+end;
+
+procedure TSkCustomControl.Resize;
+begin
+  DeleteBuffers;
+  inherited Resize;
+end;
+
+class function TSkCustomControl.GetControlClassDefaultSize: TSize;
+begin
+  Result.CX := 50;
+  Result.CY := 50;
+end;
+
+constructor TSkCustomControl.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  ControlStyle := ControlStyle + [csReplicatable] - [csOpaque];
+  FDrawCacheKind := TSkDrawCacheKind.Raster;
+  FOpacity := 255;
+  FScaleFactor := 1;
+end;
+
+destructor TSkCustomControl.Destroy;
+begin
+  DeleteBuffers;
+  inherited Destroy;
+end;
+
+procedure TSkCustomControl.Redraw;
+begin
+  FDrawCached := False;
+  Repaint;
+end;
+
+{ TSkSvgBrush }
+
+function TSkSvgBrush.GetDOM: ISkSVGDOM;
+var
+  LSvgRect: TRectF;
+begin
+  if (FDOM = nil) and HasContent then
+  begin
+    FDOM := MakeDOM;
+    if Assigned(FDOM) then
+    begin
+      LSvgRect.TopLeft := PointF(0, 0);
+      LSvgRect.Size := FDOM.Root.GetIntrinsicSize(TSizeF.Create(0, 0));
+      if (not LSvgRect.IsEmpty) or (FDOM.Root.TryGetViewBox(LSvgRect) and not LSvgRect.IsEmpty) then
+        FOriginalSize := LSvgRect.Size;
+    end;
+  end;
+  Result := FDOM;
+end;
+
+function TSkSvgBrush.GetOriginalSize: TSizeF;
+begin
+  if (FDOM = nil) and HasContent then
+    GetDOM;
+  Result := FOriginalSize;
+end;
+
+procedure TSkSvgBrush.SetGrayScale(const AValue: Boolean);
+begin
+  if FGrayScale <> AValue then
+  begin
+    FGrayScale := AValue;
+    if HasContent then
+      DoChanged;
+  end;
+end;
+
+procedure TSkSvgBrush.SetOverrideColor(const AValue: TAlphaColor);
+begin
+  if FOverrideColor <> AValue then
+  begin
+    FOverrideColor := AValue;
+    if HasContent then
+      DoChanged;
+  end;
+end;
+
+procedure TSkSvgBrush.SetSource(const AValue: TSkSvgSource);
+begin
+  if FSource <> AValue then
+  begin
+    FSource := AValue;
+    RecreateDOM;
+    DoChanged;
+  end;
+end;
+
+procedure TSkSvgBrush.SetWrapMode(const AValue: TSkSvgWrapMode);
+begin
+  if FWrapMode <> AValue then
+  begin
+    FWrapMode := AValue;
+    RecreateDOM;
+    if HasContent then
+      DoChanged;
+  end;
+end;
+
+procedure TSkSvgBrush.DoAssign(ASource: TSkSvgBrush);
+begin
+  FDOM := ASource.FDOM;
+  FGrayScale := ASource.FGrayScale;
+  FOriginalSize := ASource.FOriginalSize;
+  FOverrideColor := ASource.FOverrideColor;
+  FSource := ASource.FSource;
+  FWrapMode := ASource.FWrapMode;
+end;
+
+procedure TSkSvgBrush.DoChanged;
+begin
+  if Assigned(FOnChanged) then
+    FOnChanged(Self);
+end;
+
+function TSkSvgBrush.HasContent: Boolean;
+begin
+  Result := FSource <> '';
+end;
+
+function TSkSvgBrush.MakeDOM: ISkSVGDOM;
+begin
+  Result := TSkSVGDOM.Make(UnicodeString(FSource), TSkDefaultProviders.Resource);
+end;
+
+procedure TSkSvgBrush.RecreateDOM;
+begin
+  FDOM := nil;
+  FOriginalSize := TSizeF.Create(0, 0);
+end;
+
+constructor TSkSvgBrush.Create;
+begin
+  inherited Create;
+  FGrayScale := DefaultGrayScale;
+  FWrapMode := DefaultWrapMode;
+end;
+
+procedure TSkSvgBrush.Assign(ASource: TPersistent);
+var
+  LSourceSvgBrush: TSkSvgBrush absolute ASource;
+begin
+  if ASource is TSkSvgBrush then
+  begin
+    if not Equals(LSourceSvgBrush) then
+    begin
+      DoAssign(LSourceSvgBrush);
+      DoChanged;
+    end;
+  end
+  else
+    inherited;
+end;
+
+function TSkSvgBrush.Equals(AObject: TObject): Boolean;
+var
+  LObjectSvgBrush: TSkSvgBrush absolute AObject;
+begin
+  Result := (AObject is TSkSvgBrush) and
+    (FGrayScale = LObjectSvgBrush.FGrayScale) and
+    (FOverrideColor = LObjectSvgBrush.FOverrideColor) and
+    (FWrapMode = LObjectSvgBrush.FWrapMode) and
+    (FSource = LObjectSvgBrush.FSource);
+end;
+
+procedure TSkSvgBrush.Render(const ACanvas: ISkCanvas; const ADestRect: TRectF;
+  const AOpacity: Single);
+
+  function GetWrappedDest(const ADOM: ISkSVGDOM; const ASvgRect, ADestRect: TRectF;
+    const AIntrinsicSize: TSizeF): TRectF;
+  var
+    LRatio: Single;
+  begin
+    case FWrapMode of
+      TSkSvgWrapMode.Default:
+        begin
+          if AIntrinsicSize.IsZero then
+            Result := ADestRect
+          else
+          begin
+            Result := ASvgRect;
+            Result.Offset(ADestRect.TopLeft);
+          end;
+          ADOM.SetContainerSize(ADestRect.Size);
+        end;
+      TSkSvgWrapMode.Fit: Result := ASvgRect.FitInto(ADestRect);
+      TSkSvgWrapMode.FitCrop:
+        begin
+          if (ASvgRect.Width / ADestRect.Width) < (ASvgRect.Height / ADestRect.Height) then
+            LRatio := ASvgRect.Width / ADestRect.Width
+          else
+            LRatio := ASvgRect.Height / ADestRect.Height;
+          if SameValue(LRatio, 0, TEpsilon.Vector) then
+            Result := ADestRect
+          else
+          begin
+            Result := RectF(0, 0, Round(ASvgRect.Width / LRatio), Round(ASvgRect.Height / LRatio));
+            RectCenter(Result, ADestRect);
+          end;
+        end;
+      TSkSvgWrapMode.Original,
+      TSkSvgWrapMode.Tile: Result := ASvgRect;
+      TSkSvgWrapMode.OriginalCenter:
+        begin
+          Result := ASvgRect;
+          RectCenter(Result, ADestRect);
+        end;
+      TSkSvgWrapMode.Place: Result := PlaceIntoTopLeft(ASvgRect, ADestRect);
+      TSkSvgWrapMode.Stretch: Result := ADestRect;
+    else
+      Result := ADestRect{%H-};
+    end;
+  end;
+
+  procedure DrawTileOrCustomColor(const ACanvas: ISkCanvas; const ADOM: ISkSVGDOM;
+    const ASvgRect, ADestRect, AWrappedDest: TRectF; const AIntrinsicSize: TSizeF;
+    const AWrapMode: TSkSvgWrapMode);
+  var
+    LPicture: ISkPicture;
+    LPictureRecorder: ISkPictureRecorder;
+    LCanvas: ISkCanvas;
+    LPaint: ISkPaint;
+  begin
+    LPictureRecorder := TSkPictureRecorder.Create;
+    LCanvas := LPictureRecorder.BeginRecording(AWrappedDest.Width, AWrappedDest.Height);
+    if AIntrinsicSize.IsZero then
+    begin
+      if AWrapMode <> TSkSvgWrapMode.Default then
+      begin
+        ADOM.Root.Width  := TSkSVGLength.Create(AWrappedDest.Width,  TSkSVGLengthUnit.Pixel);
+        ADOM.Root.Height := TSkSVGLength.Create(AWrappedDest.Height, TSkSVGLengthUnit.Pixel);
+      end;
+    end
+    else
+      LCanvas.Scale(AWrappedDest.Width / ASvgRect.Width, AWrappedDest.Height / ASvgRect.Height);
+    ADOM.Render(LCanvas);
+    LPicture := LPictureRecorder.FinishRecording;
+    LPaint := TSkPaint.Create;
+    if FGrayScale then
+      LPaint.ColorFilter := TSkColorFilter.MakeMatrix(TSkColorMatrix.CreateSaturation(0))
+    else if FOverrideColor <> TAlphaColors.Null then
+      LPaint.ColorFilter := TSkColorFilter.MakeBlend(FOverrideColor, TSkBlendMode.SrcIn);
+    if FWrapMode = TSkSvgWrapMode.Tile then
+    begin
+      LPaint.Shader := LPicture.MakeShader(TSkTileMode.&Repeat, TSkTileMode.&Repeat);
+      ACanvas.DrawRect(ADestRect, LPaint);
+    end
+    else
+    begin
+      ACanvas.Translate(AWrappedDest.Left, AWrappedDest.Top);
+      ACanvas.DrawPicture(LPicture, LPaint);
+    end;
+  end;
+
+var
+  LDOM: ISkSVGDOM;
+  LSvgRect: TRectF;
+  LWrappedDest: TRectF;
+  LIntrinsicSize: TSizeF;
+begin
+  if not ADestRect.IsEmpty then
+  begin
+    LDOM := DOM;
+    if Assigned(LDOM) then
+    begin
+      LSvgRect.TopLeft := PointF(0, 0);
+      LIntrinsicSize := LDOM.Root.GetIntrinsicSize(TSizeF.Create(0, 0));
+      LSvgRect.Size := LIntrinsicSize;
+      if LSvgRect.IsEmpty and ((not LDOM.Root.TryGetViewBox(LSvgRect)) or LSvgRect.IsEmpty) then
+        Exit;
+
+      if SameValue(AOpacity, 1, TEpsilon.Position) then
+        ACanvas.Save
+      else
+        ACanvas.SaveLayerAlpha(Round(AOpacity * 255));
+      try
+        LWrappedDest := GetWrappedDest(LDOM, LSvgRect, ADestRect, LIntrinsicSize);
+        if (FOverrideColor <> TAlphaColors.Null) or (FWrapMode = TSkSvgWrapMode.Tile) or FGrayScale then
+          DrawTileOrCustomColor(ACanvas, LDOM, LSvgRect, ADestRect, LWrappedDest, LIntrinsicSize, FWrapMode)
+        else
+        begin
+          ACanvas.Translate(LWrappedDest.Left, LWrappedDest.Top);
+          if LIntrinsicSize.IsZero then
+          begin
+            if FWrapMode <> TSkSvgWrapMode.Default then
+            begin
+              LDOM.Root.Width  := TSkSVGLength.Create(LWrappedDest.Width,  TSkSVGLengthUnit.Pixel);
+              LDOM.Root.Height := TSkSVGLength.Create(LWrappedDest.Height, TSkSVGLengthUnit.Pixel);
+            end;
+          end
+          else
+            ACanvas.Scale(LWrappedDest.Width / LSvgRect.Width, LWrappedDest.Height / LSvgRect.Height);
+          LDOM.Render(ACanvas);
+        end;
+      finally
+        ACanvas.Restore;
+      end;
+    end;
+  end;
+end;
+
+{ TSkSvg }
+
+procedure TSkSvg.SetSvg(const AValue: TSkSvgBrush);
+begin
+  FSvg.Assign(AValue);
+end;
+
+procedure TSkSvg.SvgChanged(ASender: TObject);
+begin
+  Redraw;
+end;
+
+function TSkSvg.CreateSvgBrush: TSkSvgBrush;
+begin
+  Result := TSkSvgBrush.Create;
+end;
+
+procedure TSkSvg.Draw(const ACanvas: ISkCanvas; const ADest: TRectF;
+  const AOpacity: Single);
+begin
+  inherited Draw(ACanvas, ADest, AOpacity);
+  FSvg.Render(ACanvas, ADest, AOpacity);
+end;
+
+constructor TSkSvg.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FSvg := CreateSvgBrush;
+  FSvg.OnChanged := @SvgChanged;
+  DrawCacheKind := TSkDrawCacheKind.Always;
+end;
+
+destructor TSkSvg.Destroy;
+begin
+  FreeAndNil(FSvg);
+  inherited Destroy;
+end;
+
+{ TSkControlRender }
+
+class function TSkControlRender.MakeRender(
+  const ATarget: ISkControlRenderTarget; const ABackend: TSkControlRenderBackend
+  ): ISkControlRender;
+begin
+  raise ESkLcl.Create('TSkControlRender.MakeRender ToDo');
+  if ATarget=nil then ;
+  case ABackend of
+    TSkControlRenderBackend.Default,
+    TSkControlRenderBackend.Raster: Result := nil; //TSkRasterControlRender.Create(ATarget);
+    TSkControlRenderBackend.HardwareAcceleration: Result := nil; //TSkGlControlRender.Create(ATarget);
+  else
+    Result := nil{%H-};
+  end;
+end;
+
+{ TSkDefaultProviders }
+
+class constructor TSkDefaultProviders.Create;
+begin
+  FTypefaceFont := TSkTypefaceFontProvider.Create;
+end;
+
+class procedure TSkDefaultProviders.RegisterTypeface(const AFileName: string);
+begin
+  FTypefaceFont.RegisterTypeface(TSkTypeFace.MakeFromFile(UnicodeString(AFileName)));
+end;
+
+class procedure TSkDefaultProviders.RegisterTypeface(const AStream: TStream);
+begin
+  FTypefaceFont.RegisterTypeface(TSkTypeFace.MakeFromStream(AStream));
+end;
+
+end.
+

+ 57 - 0
demo/LCLSkiaPaintBox/SkiaFPC.pas

@@ -0,0 +1,57 @@
+unit SkiaFPC;
+
+{$mode ObjFPC}{$H+}
+{$ModeSwitch advancedrecords}
+
+interface
+
+uses
+  Classes, SysUtils, Types;
+
+type
+  TEpsilon = record
+  const
+    Matrix = 1E-5;
+    Vector = 1E-4;
+    Scale = 1E-4;
+    FontSize = 1E-2;
+    Position = 1E-3;
+    Angle = 1E-4;
+  end;
+
+// System.Types
+
+// move center of R to center of Bounds and return R
+function RectCenter(var R: TRect; const Bounds: TRect): TRect;
+function RectCenter(var R: TRectF; const Bounds: TRectF): TRectF;
+
+implementation
+
+function RectCenter(var R: TRect; const Bounds: TRect): TRect;
+var
+  d: integer;
+begin
+  d:=(Bounds.Left+Bounds.Right - R.Left-R.Right) div 2;
+  inc(R.Left,d);
+  inc(R.Right,d);
+  d:=(Bounds.Top+Bounds.Bottom - R.Top-R.Bottom) div 2;
+  inc(R.Top,d);
+  inc(R.Bottom,d);
+  Result:=R;
+end;
+
+function RectCenter(var R: TRectF; const Bounds: TRectF): TRectF;
+var
+  d: single;
+begin
+  d:=(Bounds.Left+Bounds.Right - R.Left-R.Right)/2;
+  R.Left+=d;
+  R.Right+=d;
+  d:=(Bounds.Top+Bounds.Bottom - R.Top-R.Bottom)/2;
+  R.Top+=d;
+  R.Bottom+=d;
+  Result:=R;
+end;
+
+end.
+

+ 89 - 0
demo/LCLSkiaPaintBox/lclskiapaintcontrol1.lpi

@@ -0,0 +1,89 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="lclskiapaintcontrol1"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <RequiredPackages>
+      <Item>
+        <PackageName Value="LCL"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="lclskiapaintcontrol1.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="LCLSkiaPaintControl1"/>
+      </Unit>
+      <Unit>
+        <Filename Value="unit1.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="SkiaLCLPaintBoxDemo"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="Unit1"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../../skiafpc/System.Skia.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../../skialcl/LCL.Skia.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../../skiafpc/SkiaFPC.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="lclskiapaintcontrol1"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../../src/skia/skia4delphi"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 25 - 0
demo/LCLSkiaPaintBox/lclskiapaintcontrol1.lpr

@@ -0,0 +1,25 @@
+program LCLSkiaPaintControl1;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  {$IFDEF HASAMIGA}
+  athreads,
+  {$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, unit1, System.Skia, LCL.Skia, SkiaFPC
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  Application.Initialize;
+  Application.CreateForm(TSkiaLCLPaintBoxDemo, SkiaLCLPaintBoxDemo);
+  Application.Run;
+end.
+

BIN
demo/LCLSkiaPaintBox/lclskiapaintcontrol1.res


BIN
demo/LCLSkiaPaintBox/powered_by.png


+ 10 - 0
demo/LCLSkiaPaintBox/unit1.lfm

@@ -0,0 +1,10 @@
+object SkiaLCLPaintBoxDemo: TSkiaLCLPaintBoxDemo
+  Left = 247
+  Height = 301
+  Top = 250
+  Width = 374
+  Caption = 'Skia LCL TSkPaintBox Demo'
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  LCLVersion = '3.99.0.0'
+end

+ 118 - 0
demo/LCLSkiaPaintBox/unit1.pas

@@ -0,0 +1,118 @@
+{
+  Demo for the LCL TSkPaintBox
+}
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs, LCL.Skia,
+  System.Skia, system.UITypes;
+
+type
+
+  { TSkiaLCLPaintBoxDemo }
+
+  TSkiaLCLPaintBoxDemo = class(TForm)
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+  private
+    procedure OnSkPaintBoxDraw(Sender: TObject; const aCanvas: ISkCanvas;
+      const {%H-}aDest: TRectF; const {%H-}aOpacity: Single);
+  public
+    LogoPNG: ISkImage;
+    SkPaintBox: TSkPaintBox;
+  end;
+
+var
+  SkiaLCLPaintBoxDemo: TSkiaLCLPaintBoxDemo;
+
+implementation
+
+{$R *.lfm}
+
+{ TSkiaLCLPaintBoxDemo }
+
+procedure TSkiaLCLPaintBoxDemo.FormCreate(Sender: TObject);
+var
+  ms: TMemoryStream;
+begin
+  SkPaintBox:=TSkPaintBox.Create(Self);
+  with SkPaintBox do
+  begin
+    Name:='SkPaintBox';
+    Align:=alClient;
+    OnDraw:=@OnSkPaintBoxDraw;
+    Parent:=Self;
+  end;
+
+  ms:=TMemoryStream.Create;
+  try
+    ms.LoadFromFile('powered_by.png');
+    ms.Position := 0;
+    LogoPNG := TSkImage.MakeFromEncodedStream(ms);
+  finally
+    ms.Free;
+  end;
+end;
+
+procedure TSkiaLCLPaintBoxDemo.FormDestroy(Sender: TObject);
+begin
+  LogoPNG:=nil;
+end;
+
+procedure TSkiaLCLPaintBoxDemo.OnSkPaintBoxDraw(Sender: TObject;
+  const aCanvas: ISkCanvas; const aDest: TRectF; const aOpacity: Single);
+var
+  SkPaint, SkPaint2: ISkPaint;
+  r: TRectF;
+  Oval: ISkRoundRect;
+  aPathBuilder: ISkPathBuilder;
+  aPath: ISkPath;
+  aTypeface: ISkTypeface;
+  aFont: ISkFont;
+  aTextBlob: ISkTextBlob;
+begin
+  aCanvas.Clear(TAlphaColors.White);
+
+  SkPaint:=TSkPaint.Create(TSkPaintStyle.Stroke);
+  SkPaint.SetAntiAlias(true);
+  SkPaint.setStrokeWidth(4);
+  SkPaint.setColor(TAlphaColors.Red);
+  r:=RectF(50, 50, 90, 110);
+  aCanvas.DrawRect(r, SkPaint);
+
+  Oval:=TSkRoundRect.Create;
+  Oval.SetOval(r);
+  Oval.Offset(40,60);
+  SkPaint.setColor(TAlphaColors.Blue);
+  aCanvas.DrawRoundRect(Oval, SkPaint);
+
+  SkPaint.setColor(TAlphaColors.Cyan);
+  aCanvas.DrawCircle(180, 50, 25, SkPaint);
+
+  r.offset(80, 0);
+  SkPaint.setColor(TAlphaColors.Yellow);
+  aCanvas.DrawRoundRect(r, 10, 10, SkPaint);
+
+  aPathBuilder:=TSkPathBuilder.Create;
+  aPathBuilder.cubicTo(768, 0, -512, 256, 256, 256);
+  aPath:=aPathBuilder.Detach;
+  SkPaint.setColor(TAlphaColors.Lime);
+  aCanvas.DrawPath(aPath, SkPaint);
+
+  aCanvas.DrawImage(LogoPNG, 128, 128);
+
+  aTypeface := TSkTypeface.MakeFromName('Monospace', TSkFontStyle.Normal);
+  aFont := TSkFont.Create(aTypeface, 18, 1);
+  aFont.Edging := TSkFontEdging.AntiAlias;
+
+  SkPaint2:=TSkPaint.Create;
+  aTextBlob:=TSkTextBlob.MakeFromText('Hello, Skia!',aFont);
+  aCanvas.DrawTextBlob(aTextBlob, 50, 25, SkPaint2);
+end;
+
+end.
+