lcl skia: added TSkCustomWinControl

demo/LCLSkiaPaintBox/LCL.Skia.pas

@@ -49,6 +49,7 @@ type
     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;
@@ -171,14 +172,14 @@ type
     function GetCanvas: TCanvas;
     //function GetDeviceContext(var WindowHandle: HWND): HDC;
     function GetDrawCacheKind: TSkDrawCacheKind;
-    function GetHeight: Integer;
+    function GetClientHeight: Integer;
     function GetScaleFactor: Single;
-    function GetWidth: Integer;
+    function GetClientWidth: Integer;
     property Canvas: TCanvas read GetCanvas;
     property DrawCacheKind: TSkDrawCacheKind read GetDrawCacheKind;
-    property Height: Integer read GetHeight;
+    property ClientHeight: Integer read GetClientHeight;
     property ScaleFactor: Single read GetScaleFactor;
-    property Width: Integer read GetWidth;
+    property ClientWidth: Integer read GetClientWidth;
   end;
 
   { ISkControlRender }
@@ -197,6 +198,48 @@ type
     class function MakeRender(const ATarget: ISkControlRenderTarget; const ABackend: TSkControlRenderBackend): ISkControlRender; static;
   end;
 
+  { TSkCustomWinControl }
+
+  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
@@ -486,6 +529,12 @@ begin
   Repaint;
 end;
 
+procedure TSkCustomControl.Invalidate;
+begin
+  FDrawCached := false;
+  inherited Invalidate;
+end;
+
 { TSkSvgBrush }
 
 function TSkSvgBrush.GetDOM: ISkSVGDOM;
@@ -794,23 +843,286 @@ begin
   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
+  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
-  raise ESkLcl.Create('TSkControlRender.MakeRender ToDo');
   if ATarget=nil then ;
   case ABackend of
     TSkControlRenderBackend.Default,
-    TSkControlRenderBackend.Raster: Result := nil; //TSkRasterControlRender.Create(ATarget);
+    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;