diff --git a/components/skia/README.txt b/components/skia/README.txt
new file mode 100644
index 000000000..547dd751c
--- /dev/null
+++ b/components/skia/README.txt
@@ -0,0 +1 @@
+see https://wiki.freepascal.org/Skia
diff --git a/components/skia/demo/console/ConsoleAppSkiaFPC.lpi b/components/skia/demo/console/ConsoleAppSkiaFPC.lpi
new file mode 100644
index 000000000..6a5f10577
--- /dev/null
+++ b/components/skia/demo/console/ConsoleAppSkiaFPC.lpi
@@ -0,0 +1,71 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ -
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ -
+
+
+ -
+
+
+ -
+
+
+
+
+
diff --git a/components/skia/demo/console/ConsoleAppSkiaFPC.lpr b/components/skia/demo/console/ConsoleAppSkiaFPC.lpr
new file mode 100644
index 000000000..b7ebc545d
--- /dev/null
+++ b/components/skia/demo/console/ConsoleAppSkiaFPC.lpr
@@ -0,0 +1,41 @@
+{
+ Demo for a console app using the libsk4d library to create a surface, draw
+ on the canvas, and save the result as png file.
+
+ Note: In skia4delphi 6.1 when the library is not found it silently aborts.
+}
+program ConsoleAppSkiaFPC;
+
+{$IFDEF MSWindows}
+ {$APPTYPE CONSOLE}
+{$ENDIF}
+
+uses
+ {$IFDEF UNIX}
+ cthreads,
+ {$ENDIF}
+ dynlibs { dynlibs is needed when loading dynamic lib libsk4d },
+ SysUtils, System.UITypes,
+ System.Skia;
+
+procedure TestSkSurface;
+var
+ LSurface: ISkSurface;
+begin
+ // Creating a solid red image using SkSurface
+ LSurface := TSkSurface.MakeRaster(200, 200);
+ LSurface.Canvas.Clear(TAlphaColors.Red); // $FFFF0000
+ // create png file
+ LSurface.MakeImageSnapshot.EncodeToFile('test.png');
+end;
+
+begin
+ try
+ TestSkSurface;
+ WriteLn('Created test.png, ');
+ ReadLn;
+ except
+ on E: Exception do
+ Writeln(E.ClassName, ': ', E.Message);
+ end;
+end.
diff --git a/components/skia/demo/paintbox/PaintControlSkLCL.lpi b/components/skia/demo/paintbox/PaintControlSkLCL.lpi
new file mode 100644
index 000000000..92c67056c
--- /dev/null
+++ b/components/skia/demo/paintbox/PaintControlSkLCL.lpi
@@ -0,0 +1,76 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ -
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ -
+
+
+ -
+
+
+ -
+
+
+
+
+
diff --git a/components/skia/demo/paintbox/PaintControlSkLCL.lpr b/components/skia/demo/paintbox/PaintControlSkLCL.lpr
new file mode 100644
index 000000000..dcf6f1981
--- /dev/null
+++ b/components/skia/demo/paintbox/PaintControlSkLCL.lpr
@@ -0,0 +1,29 @@
+{
+ Demo for the LCL TSkPaintBox
+}
+program PaintControlSkLCL;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}
+ cthreads,
+ {$ENDIF}
+ {$IFDEF HASAMIGA}
+ athreads,
+ {$ENDIF}
+ Interfaces { this includes the LCL widgetset }
+ Forms,
+ LCL.SkiaInit { helper unit, to show an error if the libsk4d library was not found },
+ unit1;
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource:=True;
+ Application.Scaled:=True;
+ Application.Initialize;
+ Application.CreateForm(TSkiaLCLPaintBoxDemo, SkiaLCLPaintBoxDemo);
+ Application.Run;
+end.
+
diff --git a/components/skia/demo/paintbox/PaintControlSkLCL.res b/components/skia/demo/paintbox/PaintControlSkLCL.res
new file mode 100644
index 000000000..18ed76a9f
Binary files /dev/null and b/components/skia/demo/paintbox/PaintControlSkLCL.res differ
diff --git a/components/skia/demo/paintbox/powered_by.png b/components/skia/demo/paintbox/powered_by.png
new file mode 100644
index 000000000..d065776c1
Binary files /dev/null and b/components/skia/demo/paintbox/powered_by.png differ
diff --git a/components/skia/demo/paintbox/unit1.lfm b/components/skia/demo/paintbox/unit1.lfm
new file mode 100644
index 000000000..a140c09df
--- /dev/null
+++ b/components/skia/demo/paintbox/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
diff --git a/components/skia/demo/paintbox/unit1.pas b/components/skia/demo/paintbox/unit1.pas
new file mode 100644
index 000000000..b6a0a9569
--- /dev/null
+++ b/components/skia/demo/paintbox/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.
+
diff --git a/components/skia/design/Skia.LCL.Design.lpk b/components/skia/design/Skia.LCL.Design.lpk
new file mode 100644
index 000000000..a1895ea8a
--- /dev/null
+++ b/components/skia/design/Skia.LCL.Design.lpk
@@ -0,0 +1,39 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ -
+
+
+
+
+
+
+ -
+
+
+ -
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/skia/design/SkiaLCLRegister.pas b/components/skia/design/SkiaLCLRegister.pas
new file mode 100644
index 000000000..19bbe7af8
--- /dev/null
+++ b/components/skia/design/SkiaLCLRegister.pas
@@ -0,0 +1,23 @@
+unit SkiaLCLRegister;
+
+{$mode objfpc}{$H+}
+{$IF FPC_FULLVERSION<30301}
+ {$error requires at least fpc 3.3.1}
+{$ENDIF}
+
+interface
+
+uses
+ LCL.Skia;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+ RegisterComponents('Skia', [TSkPaintBox]);
+end;
+
+end.
+
diff --git a/components/skia/skia4d_package/Lazarus/Skia.lpk b/components/skia/skia4d_package/Lazarus/Skia.lpk
new file mode 100644
index 000000000..b52de1627
--- /dev/null
+++ b/components/skia/skia4d_package/Lazarus/Skia.lpk
@@ -0,0 +1,40 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ -
+
+
+
+ -
+
+
+
+
+
+ -
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/skia/skia4d_package/Lazarus/Skia.pas b/components/skia/skia4d_package/Lazarus/Skia.pas
new file mode 100644
index 000000000..5ccd43692
--- /dev/null
+++ b/components/skia/skia4d_package/Lazarus/Skia.pas
@@ -0,0 +1,21 @@
+{ This file was automatically created by Lazarus. Do not edit!
+ This source is only used to compile and install the package.
+ }
+
+unit Skia;
+
+{$warn 5023 off : no warning about unused units}
+interface
+
+uses
+ System.Skia.API, System.Skia, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+end;
+
+initialization
+ RegisterPackage('Skia', @Register);
+end.
diff --git a/components/skia/src/LCL.Skia.pas b/components/skia/src/LCL.Skia.pas
new file mode 100644
index 000000000..ff13c19a6
--- /dev/null
+++ b/components/skia/src/LCL.Skia.pas
@@ -0,0 +1,1149 @@
+unit LCL.Skia;
+
+{$Mode ObjFPC}{$H+}
+{$ScopedEnums On}
+{$IF FPC_FULLVERSION<30301}
+ {$error requires at least fpc 3.3.1}
+{$ENDIF}
+
+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;
+ procedure Invalidate; override;
+ 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 GetClientHeight: Integer;
+ function GetScaleFactor: Single;
+ function GetClientWidth: Integer;
+ property Canvas: TCanvas read GetCanvas;
+ property DrawCacheKind: TSkDrawCacheKind read GetDrawCacheKind;
+ property ClientHeight: Integer read GetClientHeight;
+ property ScaleFactor: Single read GetScaleFactor;
+ property ClientWidth: Integer read GetClientWidth;
+ 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;
+
+ { TSkCustomWinControl - base class for your custom controls }
+
+ TSkCustomWinControl = class abstract(TCustomControl, ISkControlRenderTarget)
+ private
+ FBackendRender: TSkControlRenderBackend;
+ FBackgroundColor: TAlphaColor;
+ FDrawCacheKind: TSkDrawCacheKind;
+ FOnDraw: TSkDrawEvent;
+ FRender: ISkControlRender;
+ FScaleFactor: Single;
+ function GetRender: ISkControlRender;
+ procedure DeleteBuffers;
+ procedure SetBackendRender(AValue: TSkControlRenderBackend);
+ procedure SetBackgroundColor(AValue: TAlphaColor);
+ procedure SetDrawCacheKind(AValue: TSkDrawCacheKind);
+ procedure SetOnDraw(AValue: TSkDrawEvent);
+ protected
+ procedure DestroyWnd; override; // called after child handles are freed
+ procedure DrawContent(const ACanvas: ISkCanvas; const ADest: TRectF; const AOpacity: Single); virtual;
+ function MakeRender(ABackendRender: TSkControlRenderBackend): ISkControlRender; virtual;
+ procedure Paint; override;
+ procedure Resize; override;
+ procedure ChangeScale(Multiplier, Divider: Integer); override;
+ class function GetControlClassDefaultSize: TSize; override;
+ // for interface ISkControlRenderTarget:
+ procedure Draw(const ACanvas: ISkCanvas; const ADest: TRectF; const AOpacity: Single); virtual;
+ function GetCanvas: TCanvas; virtual;
+ function GetDrawCacheKind: TSkDrawCacheKind; virtual;
+ function GetClientHeight: Integer; virtual;
+ function GetScaleFactor: Single; virtual;
+ function GetClientWidth: Integer; virtual;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property BackendRender: TSkControlRenderBackend read FBackendRender write SetBackendRender default TSkControlRenderBackend.Default;
+ property BackgroundColor: TAlphaColor read FBackgroundColor write SetBackgroundColor default TAlphaColors.White;
+ property DrawCacheKind: TSkDrawCacheKind read FDrawCacheKind write SetDrawCacheKind default TSkDrawCacheKind.Raster;
+ property OnDraw: TSkDrawEvent read FOnDraw write SetOnDraw;
+ property Render: ISkControlRender read GetRender;
+ property ScaleFactor: Single read FScaleFactor;
+ 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;
+
+procedure TSkCustomControl.Invalidate;
+begin
+ FDrawCached := false;
+ inherited Invalidate;
+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;
+
+type
+ { TSkRasterControlRender }
+
+ TSkRasterControlRender = class(TSkControlRender, ISkControlRender)
+ strict private
+ FDrawCached: Boolean;
+ FIntfImg: TLazIntfImage;
+ FTarget: ISkControlRenderTarget;
+ procedure DeleteBuffers;
+ procedure DoRender(const AWidth, AHeight: Integer; const AScaleFactor: Single;
+ const ACanvas: TCanvas{; const ABackgroundBuffer: TBitmap; const AOpacity: Byte});
+ public
+ constructor Create(const ATarget: ISkControlRenderTarget);
+ destructor Destroy; override;
+ procedure Redraw;
+ procedure Resized;
+ procedure ISkControlRender.Resized = DeleteBuffers;
+ function TryRender(const ABackgroundBuffer: TBitmap; const AOpacity: Byte): Boolean;
+ end;
+
+procedure TSkRasterControlRender.DeleteBuffers;
+begin
+ FDrawCached := False;
+ FreeAndNil(FIntfImg);
+end;
+
+procedure TSkRasterControlRender.DoRender(const AWidth, AHeight: Integer;
+ const AScaleFactor: Single; const ACanvas: TCanvas);
+
+ procedure InternalDraw;
+ var
+ LSurface: ISkSurface;
+ LDestRect: TRectF;
+ begin
+ LSurface := TSkSurface.MakeRasterDirect(TSkImageInfo.Create(AWidth, AHeight),
+ FIntfImg.PixelData, FIntfImg.DataDescription.BytesPerLine);
+ if LSurface = nil then
+ Exit;
+ LSurface.Canvas.Concat(TMatrix.CreateScaling(AScaleFactor, AScaleFactor));
+ LDestRect := RectF(0, 0, AWidth / AScaleFactor, AHeight / AScaleFactor);
+ LSurface.Canvas.Clear(TAlphaColors.Null);
+ FTarget.Draw(LSurface.Canvas, LDestRect, 1);
+ FDrawCached := True;
+ end;
+
+var
+ Desc: TRawImageDescription;
+ Bmp: TBitmap;
+begin
+ if (AWidth <= 0) or (AHeight <= 0) then
+ Exit;
+
+ if FIntfImg=nil then
+ begin
+ if SkNative32ColorType=TSkColorType.BGRA8888 then
+ Desc.Init_BPP32_B8G8R8A8_BIO_TTB(AWidth, AHeight)
+ else
+ Desc.Init_BPP32_R8G8B8A8_BIO_TTB(AWidth, AHeight);
+ FIntfImg:=TLazIntfImage.Create(0,0);
+ FIntfImg.DataDescription:=Desc;
+ FIntfImg.SetSize(AWidth,AHeight);
+ end else if (FIntfImg.Width<>AWidth) or (FIntfImg.Height<>AHeight) then begin
+ FIntfImg.SetSize(AWidth,AHeight);
+ end;
+
+ if (not FDrawCached) or (FTarget.DrawCacheKind = TSkDrawCacheKind.Never) then
+ InternalDraw;
+
+ Bmp:=TBitmap.Create;
+ try
+ Bmp.LoadFromIntfImage(FIntfImg);
+ ACanvas.Draw(0,0,Bmp);
+ finally
+ Bmp.Free;
+ end;
+end;
+
+constructor TSkRasterControlRender.Create(
+ const ATarget: ISkControlRenderTarget);
+begin
+ inherited Create;
+ FTarget := ATarget;
+end;
+
+destructor TSkRasterControlRender.Destroy;
+begin
+ DeleteBuffers;
+ inherited;
+end;
+
+procedure TSkRasterControlRender.Redraw;
+begin
+ FDrawCached := False;
+end;
+
+procedure TSkRasterControlRender.Resized;
+begin
+
+end;
+
+function TSkRasterControlRender.TryRender(const ABackgroundBuffer: TBitmap; const AOpacity: Byte): Boolean;
+begin
+ if AOpacity=0 then exit;
+ if ABackgroundBuffer=nil then ;
+ DoRender(FTarget.ClientWidth, FTarget.ClientHeight, FTarget.ScaleFactor, FTarget.Canvas{, ABackgroundBuffer, AOpacity});
+ Result := True;
+end;
+
+{ TSkControlRender }
+
+class function TSkControlRender.MakeRender(
+ const ATarget: ISkControlRenderTarget; const ABackend: TSkControlRenderBackend
+ ): ISkControlRender;
+begin
+ if ATarget=nil then ;
+ case ABackend of
+ TSkControlRenderBackend.Default,
+ TSkControlRenderBackend.Raster: Result := TSkRasterControlRender.Create(ATarget);
+ TSkControlRenderBackend.HardwareAcceleration: Result := nil; //TSkGlControlRender.Create(ATarget);
+ else
+ Result := nil{%H-};
+ end;
+end;
+
+{ TSkCustomWinControl }
+
+function TSkCustomWinControl.GetRender: ISkControlRender;
+begin
+ if FRender = nil then
+ FRender := MakeRender(FBackendRender);
+ Result := FRender;
+end;
+
+procedure TSkCustomWinControl.DeleteBuffers;
+begin
+
+end;
+
+procedure TSkCustomWinControl.SetBackendRender(AValue: TSkControlRenderBackend);
+begin
+ if FBackendRender=AValue then Exit;
+ FBackendRender := AValue;
+ FRender := nil;
+end;
+
+procedure TSkCustomWinControl.SetBackgroundColor(AValue: TAlphaColor);
+begin
+ if FBackgroundColor=AValue then Exit;
+ FBackgroundColor:=AValue;
+ Invalidate;
+end;
+
+procedure TSkCustomWinControl.SetDrawCacheKind(AValue: TSkDrawCacheKind);
+begin
+ if FDrawCacheKind=AValue then Exit;
+ FDrawCacheKind:=AValue;
+ if FDrawCacheKind <> TSkDrawCacheKind.Always then
+ Invalidate;
+end;
+
+procedure TSkCustomWinControl.SetOnDraw(AValue: TSkDrawEvent);
+begin
+ if FOnDraw=AValue then Exit;
+ FOnDraw:=AValue;
+ Invalidate;
+end;
+
+procedure TSkCustomWinControl.DestroyWnd;
+begin
+ FRender:=nil;
+ inherited DestroyWnd;
+end;
+
+procedure TSkCustomWinControl.DrawContent(const ACanvas: ISkCanvas;
+ const ADest: TRectF; const AOpacity: Single);
+begin
+ if csDesigning in ComponentState then
+ DrawDesignBorder(ACanvas, ADest, AOpacity);
+ if Assigned(FOnDraw) then
+ FOnDraw(Self, ACanvas, ADest, AOpacity);
+end;
+
+procedure TSkCustomWinControl.Draw(const ACanvas: ISkCanvas;
+ const ADest: TRectF; const AOpacity: Single);
+var
+ LPaint: ISkPaint;
+begin
+ if TAlphaColorRec(FBackgroundColor).A > 0 then
+ begin
+ LPaint := TSkPaint.Create;
+ LPaint.Color := FBackgroundColor;
+ LPaint.AntiAlias := True;
+ ACanvas.DrawRect(ADest, LPaint);
+ end;
+ DrawContent(ACanvas,ADest,AOpacity);
+end;
+
+function TSkCustomWinControl.MakeRender(ABackendRender: TSkControlRenderBackend
+ ): ISkControlRender;
+begin
+ Result := TSkControlRender.MakeRender(Self, ABackendRender);
+end;
+
+procedure TSkCustomWinControl.Paint;
+var
+ LBackgroundBuffer: TBitmap;
+begin
+ if (Width <= 0) or (Height <= 0) or (Render = nil) then
+ Exit;
+ LBackgroundBuffer := nil;
+ if not FRender.TryRender(LBackgroundBuffer, 255)
+ and (FBackendRender = TSkControlRenderBackend.HardwareAcceleration) then
+ begin
+ FRender := MakeRender(TSkControlRenderBackend.Raster);
+ if FRender <> nil then
+ FRender.Redraw;
+ end;
+ inherited Paint;
+end;
+
+procedure TSkCustomWinControl.Resize;
+begin
+ if FRender <> nil then
+ FRender.Resized;
+ DeleteBuffers;
+ inherited Resize;
+end;
+
+class function TSkCustomWinControl.GetControlClassDefaultSize: TSize;
+begin
+ Result.cx:=80;
+ Result.cy:=80;
+end;
+
+function TSkCustomWinControl.GetCanvas: TCanvas;
+begin
+ Result := Canvas;
+end;
+
+function TSkCustomWinControl.GetDrawCacheKind: TSkDrawCacheKind;
+begin
+ Result := FDrawCacheKind;
+end;
+
+function TSkCustomWinControl.GetClientHeight: Integer;
+begin
+ Result := ClientHeight;
+end;
+
+function TSkCustomWinControl.GetScaleFactor: Single;
+begin
+ Result := ScaleFactor;
+end;
+
+function TSkCustomWinControl.GetClientWidth: Integer;
+begin
+ Result := ClientWidth;
+end;
+
+procedure TSkCustomWinControl.ChangeScale(Multiplier, Divider: Integer);
+begin
+ if Multiplier <> Divider then
+ FScaleFactor := FScaleFactor * Multiplier / Divider;
+ inherited ChangeScale(Multiplier, Divider);
+end;
+
+constructor TSkCustomWinControl.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FBackgroundColor := TAlphaColors.White;
+ FDrawCacheKind := TSkDrawCacheKind.Raster;
+ FScaleFactor := 1;
+ ControlStyle:=ControlStyle+[csAcceptsControls,csOpaque];
+end;
+
+destructor TSkCustomWinControl.Destroy;
+begin
+ DeleteBuffers;
+ FRender := nil;
+ inherited Destroy;
+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.
+
diff --git a/components/skia/src/LCL.SkiaInit.pas b/components/skia/src/LCL.SkiaInit.pas
new file mode 100644
index 000000000..673f1b944
--- /dev/null
+++ b/components/skia/src/LCL.SkiaInit.pas
@@ -0,0 +1,28 @@
+{
+ The System.Skia.API unit loads the libsk4d library in its class constructors,
+ which eats any error message.
+ This unit logs an error via the LazLogger unit.
+
+}
+unit LCL.SkiaInit;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ SysUtils, LazLogger, System.Skia.API;
+
+implementation
+
+initialization
+ try
+ SkInitialize;
+ except
+ on E: Exception do begin
+ DebugLn('Failed loading skia libb: '+E.Message);
+ Halt(1);
+ end;
+ end;
+end.
+
diff --git a/components/skia/src/SkiaFPC.pas b/components/skia/src/SkiaFPC.pas
new file mode 100644
index 000000000..002152003
--- /dev/null
+++ b/components/skia/src/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.
+
diff --git a/components/skia/src/skia.lcl.lpk b/components/skia/src/skia.lcl.lpk
new file mode 100644
index 000000000..95dedb5e6
--- /dev/null
+++ b/components/skia/src/skia.lcl.lpk
@@ -0,0 +1,45 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ -
+
+
+
+ -
+
+
+
+ -
+
+
+
+
+
+ -
+
+
+ -
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/skia/src/skia.lcl.pas b/components/skia/src/skia.lcl.pas
new file mode 100644
index 000000000..90c3af0d8
--- /dev/null
+++ b/components/skia/src/skia.lcl.pas
@@ -0,0 +1,21 @@
+{ This file was automatically created by Lazarus. Do not edit!
+ This source is only used to compile and install the package.
+ }
+
+unit Skia.LCL;
+
+{$warn 5023 off : no warning about unused units}
+interface
+
+uses
+ LCL.Skia, LCL.SkiaInit, SkiaFPC, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+end;
+
+initialization
+ RegisterPackage('Skia.LCL', @Register);
+end.