renderer: clip

demo/ScrollBox/.gitignore

@@ -1 +1,2 @@
 ScrollBoxDemo1
+ScrollBoxLCLDemo1

demo/ScrollBox/ScrollBoxLCLDemo1.lpi

@@ -0,0 +1,76 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="ScrollBoxLCLDemo1"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+      <Icon Value="0"/>
+    </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="FresnelLCL"/>
+        <DefaultFilename Value="../../src/lcl/fresnellcl.lpk" Prefer="True"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="ScrollBoxLCLDemo1.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="MainUnit.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="MainForm"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Other"/>
+        <ResourceBaseClassname Value="TFresnelForm"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="ScrollBoxLCLDemo1"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf2"/>
+      </Debugging>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

demo/ScrollBox/ScrollBoxLCLDemo1.lpr

@@ -0,0 +1,20 @@
+program ScrollBoxLCLDemo1;
+
+uses
+  {$IFDEF Unix}
+  cthreads,
+  {$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Fresnel, // this includes the Fresnel-LCL widgetset
+  Forms, MainUnit;
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  Application.Initialize;
+  Application.CreateForm(TMainForm,MainForm);
+  Application.Run;
+end.
+

src/base/fresnel.dom.pas

@@ -1065,8 +1065,10 @@ type
   TFresnelLayoutModes = set of TFresnelLayoutMode;
 
   TFresnelLayoutFlag = (
-    flfHorizontalScrollbar,
-    flfVerticalScrollbar
+    flfClipHorizontal,
+    flfClipVertical,
+    flfScrollbarHorizontal,
+    flfScrollbarVertical
     );
   TFresnelLayoutFlags = set of TFresnelLayoutFlag;
 

src/base/fresnel.layouter.pas

@@ -259,6 +259,8 @@ var
   HasMaxWidth, HasMaxHeight: Boolean;
   El: TFresnelElement;
 begin
+  El:=Node.Element;
+
   MaxWidth:=Node.Width;
   if IsNan(MaxWidth) then
     MaxWidth:=Node.MaxWidth;
@@ -316,13 +318,12 @@ begin
     writeln('TFLNodeLayouter.Apply "',Node.Element.Name,'" ScrollSize: ',FloatToCSSStr(Node.ScrollWidth),'x',FloatToCSSStr(Node.ScrollHeight),' Width=',FloatToCSSStr(Node.Width),' Height=',FloatToCSSStr(Node.Height));
     {$ENDIF}
 
-    El:=Node.Element;
     if Node.ScrollbarWidth<>CSSRegistry.kwNone then
     begin
       if (Node.ScrollWidth>aClientWidth) and (El.ComputedOverflowX<>CSSRegistry.kwHidden) then
-        Include(Node.Flags,flfHorizontalScrollbar);
+        Include(Node.Flags,flfScrollbarHorizontal);
       if (Node.ScrollHeight>aClientHeight) and (El.ComputedOverflowY<>CSSRegistry.kwHidden) then
-        Include(Node.Flags,flfVerticalScrollbar);
+        Include(Node.Flags,flfScrollbarVertical);
     end;
 
     // todo: ScrollLeft, ScrollTop
@@ -338,6 +339,15 @@ begin
     Node.ScrollWidth:=Max(Size.X,Node.Width);
     Node.ScrollHeight:=Max(Size.Y,Node.Height);
   end;
+
+  // clipping
+  if (El.ComputedOverflowX<>CSSRegistry.kwVisible) and (Node.ScrollWidth>El.ClientWidth) then
+  begin
+    //writeln('TFLNodeLayouter.Apply ',El.Name,' ',CSSRegistry.Keywords[El.ComputedOverflowX],' ScrollWidth=',FloatToCSSStr(Node.ScrollWidth),' ClientWidth=',FloatToCSSStr(El.ClientWidth));
+    Include(Node.Flags,flfClipHorizontal);
+  end;
+  if (El.ComputedOverflowY<>CSSRegistry.kwVisible) and (Node.ScrollHeight>El.ClientHeight) then
+    Include(Node.Flags,flfClipVertical);
 end;
 
 procedure TFLNodeLayouter.Init;

src/base/fresnel.renderer.pas

@@ -89,7 +89,7 @@ type
     // Draw the border of the element. This is called after drawing the background. Not called if PrepareBackgroundBorder returned False.
     procedure DrawElBorder(El: TFresnelElement; Params: TBorderAndBackground); virtual;
     function CreateScrollBar : TScrollBar; virtual;
-    // Draw the scrollbars of the element. Called after drawing borders.
+    // Draw the scrollbars of the element. Called after drawing content.
     procedure DrawScrollBar(El: TFresnelElement; aBar: TScrollBar); virtual;
     procedure DrawScrollBarCorner(El: TFresnelElement; const r: TFresnelRect); virtual;
     procedure DrawScrollBars(El: TFresnelElement); virtual;
@@ -121,24 +121,29 @@ type
     {  IFresnelRenderer }
     // Add 1 Shadow text to
     procedure AddTextShadow(const aX, aY: TFresnelLength; const aColor: TFPColor; const aRadius: TFresnelLength);
+    // Draw an elliptic arc with with given center and radii, from start to stop angle in rad (0=right), using specified color.
+    procedure Arc(const aColor : TFPColor; const aCenter, aRadii : TFresnelPoint; aStartAngle : TFresnelLength = 0; aStopAngle : TFresnelLength = DoublePi); virtual; abstract;
     // Clear all text shadows
     procedure ClearTextShadows;
+    procedure ClipRect(const aRect: TFresnelRect); virtual; abstract;
+    // Draw an image
+    procedure DrawImage(const aLeft, aTop, aWidth, aHeight: TFresnelLength; const aImage: TFPCustomImage); virtual; abstract;
     // Get reference to TFresnelTextShadow. Index between 0 and GetTextShadowCount-1
     function GetTextShadow(aIndex : Integer): PFresnelTextShadow;
     // Number of TextShadows that will be applied
     function GetTextShadowCount: Integer;
     // Draw and fill a rectangle with given boundaries and color.
     procedure FillRect(const aColor: TFPColor; const aRect: TFresnelRect); virtual; abstract;
-    // Draw an elliptic arc with with given center and radii, from start to stop angle in rad (0=right), using specified color.
-    procedure Arc(const aColor : TFPColor; const aCenter, aRadii : TFresnelPoint; aStartAngle : TFresnelLength = 0; aStopAngle : TFresnelLength = DoublePi); virtual; abstract;
-    // Draw (and optionally fill) a rounded rectangle with given boundaries and color.
-    procedure RoundRect(const aColor: TFPColor; const aRect: TFresnelRoundRect; Fill : Boolean); virtual; abstract;
     // Draw a line from point A (x1,y1) to B (x2,y2) using given color.
     procedure Line(const aColor: TFPColor; const x1, y1, x2, y2: TFresnelLength); virtual; abstract;
+    // Restores a saved state of clipping and matrix.
+    procedure Restore; virtual; abstract;
+    // Draw (and optionally fill) a rounded rectangle with given boundaries and color.
+    procedure RoundRect(const aColor: TFPColor; const aRect: TFresnelRoundRect; Fill : Boolean); virtual; abstract;
+    // Save clipping and matrix, must be balanced with Restore
+    procedure Save; virtual; abstract;
     // Draw a text (aText) at aTop,aLeft using given color and font.
     procedure TextOut(const aLeft, aTop: TFresnelLength; const aFont: IFresnelFont; const aColor: TFPColor; const aText: string); virtual; abstract;
-    // Draw an image
-    procedure DrawImage(const aLeft, aTop, aWidth, aHeight: TFresnelLength; const aImage: TFPCustomImage); virtual; abstract;
     // Origin of the currently drawn
     property Origin: TFresnelPoint read GetOrigin write SetOrigin;
     // Number of TextShadows that will be applied
@@ -593,8 +598,8 @@ var
   IsLeft, HasVertBar, HasHorzBar: Boolean;
 begin
   LNode:=TUsedLayoutNode(El.LayoutNode);
-  HasVertBar:=flfVerticalScrollbar in LNode.Flags;
-  HasHorzBar:=flfHorizontalScrollbar in LNode.Flags;
+  HasVertBar:=flfScrollbarVertical in LNode.Flags;
+  HasHorzBar:=flfScrollbarHorizontal in LNode.Flags;
   if (not HasVertBar) and (not HasHorzBar) then exit;
 
   if HasVertBar then
@@ -612,6 +617,7 @@ begin
     else BarHeight:=El.Viewport.ScrollbarsWidth[true];
     end;
   aPaddingBox:=El.GetRenderedPaddingBox;
+  //writeln('TFresnelRenderer.DrawScrollBars ',El.Name,' PaddingBox=',aPaddingBox.ToString);
 
   if HasVertBar then
   begin
@@ -635,7 +641,7 @@ begin
         aScrollbar.Color:=El.GetComputedColor(fcaScrollbarColor,colGray);
 
         {$IFDEF VerboseFresnelScrolling}
-        writeln('TFresnelRenderer.DrawScrollBars ',El.Name,' ScrollHeight=',FloatToCSSStr(El.ScrollHeight),' ClientHeight',FloatToCSSStr(El.ClientHeight),' ScrollTop=',FloatToCSSStr(El.ScrollTop)+' BarWidth='+FloatToCSSStr(BarWidth));
+        writeln('TFresnelRenderer.DrawScrollBars ',El.Name,' ScrollHeight=',FloatToCSSStr(El.ScrollHeight),' ClientHeight',FloatToCSSStr(El.ClientHeight),' ScrollTop=',FloatToCSSStr(El.ScrollTop)+' BarWidth='+FloatToCSSStr(BarWidth)+' r='+r.ToString);
         {$ENDIF}
         DrawScrollBar(El,aScrollbar);
       finally
@@ -696,11 +702,13 @@ end;
 procedure TFresnelRenderer.DrawElement(El: TFresnelElement);
 var
   LNode: TUsedLayoutNode;
-  aBorderBox, aContentBox: TFresnelRect;
+  aBorderBox, aContentBox, r: TFresnelRect;
   BorderParams: TBorderAndBackground;
   aRenderable : IFresnelRenderable;
   s: TFresnelCSSSide;
   Corner: TFresnelCSSCorner;
+  aClientWidth, aClientHeight: TFresnelLength;
+  NeedClipHorizontal, NeedClipVertical, NeedRestore: Boolean;
 begin
   FLLog(etDebug,'TFresnelRenderer.DrawElement %s Origin=%s',[El.GetPath,Origin.ToString]);
   LNode:=TUsedLayoutNode(El.LayoutNode);
@@ -757,14 +765,39 @@ begin
     BorderParams.Free;
   end;
 
-  // draw scrollbars
-  DrawScrollBars(El);
+  NeedRestore:=false;
+  NeedClipHorizontal:=flfClipHorizontal in LNode.Flags;
+  NeedClipVertical:=flfClipVertical in LNode.Flags;
+  if NeedClipHorizontal or NeedClipVertical then
+  begin
+    //writeln('TFresnelRenderer.DrawElement ',El.Name,' ',NeedClipHorizontal,' ',NeedClipVertical);
+    r:=El.GetRenderedPaddingBox;
+    if not NeedClipHorizontal then
+    begin
+      r.Left:=-Origin.X;
+      r.Right:=El.Viewport.Width-Origin.X;
+    end else if not NeedClipVertical then
+    begin
+      r.Top:=-Origin.Y;
+      r.Bottom:=El.Viewport.Height-Origin.Y;
+    end;
 
-  // Give element a chance to draw itself (on top of background and border)
-  aRenderable.Render(Self as IFresnelRenderer);
+    Save;
+    NeedRestore:=true;
+    ClipRect(r);
+  end;
+  try
+    // Give element a chance to draw itself (on top of background and border)
+    aRenderable.Render(Self as IFresnelRenderer);
 
-  DrawChildren(El);
+    DrawChildren(El);
 
+    // draw scrollbars
+    DrawScrollBars(El);
+  finally
+    if NeedRestore then
+      Restore;
+  end;
   aRenderable.AfterRender;
 end;
 

src/lcl/fresnel.lcl.pas

@@ -90,15 +90,18 @@ type
     function RadToLCLAngle16(Angle: TFresnelLength): integer;
     procedure Arc(const aColor: TFPColor; const aCenter, aRadii: TFresnelPoint;
       aStartAngle: TFresnelLength = 0; aStopAngle: TFresnelLength = DoublePi); override;
+    procedure ClipRect(const aRect: TFresnelRect); override;
+    procedure DrawImage(const aLeft, aTop, aWidth, aHeight: TFresnelLength;
+      const aImage: TFPCustomImage); override;
     procedure FillRect(const aColor: TFPColor; const aRect: TFresnelRect); override;
     procedure Line(const aColor: TFPColor; const x1, y1, x2, y2: TFresnelLength); override;
+    procedure Restore; override;
     procedure RoundRect(const aColor: TFPColor; const aRect: TFresnelRoundRect;
       Fill: Boolean); override;
+    procedure Save; override;
     procedure TextOut(const aLeft, aTop: TFresnelLength;
       const aFont: IFresnelFont; const aColor: TFPColor;
       const aText: string); override;
-    procedure DrawImage(const aLeft, aTop, aWidth, aHeight: TFresnelLength;
-      const aImage: TFPCustomImage); override;
 
     property Canvas: TCanvas read FCanvas write FCanvas;
   end;
@@ -179,6 +182,7 @@ var
 function CompareFresnelLCLFont(Item1, Item2: Pointer): integer;
 function CompareFresnelFontDescWithLCLFont(Key, Item: Pointer): integer;
 procedure FresnelRectToRect(const Src: TFresnelRect; out Dest: TRect);
+procedure FresnelRectOffsetToRect(const Src: TFresnelRect; const Offset: TFresnelPoint; out Dest: TRect);
 procedure FresnelPointsToPoints(const Src: TFresnelPointArray; out Dest: TPointArray);
 
 implementation
@@ -229,6 +233,15 @@ begin
   Dest.Bottom:=ceil(Src.Bottom);
 end;
 
+procedure FresnelRectOffsetToRect(const Src: TFresnelRect; const Offset: TFresnelPoint; out
+  Dest: TRect);
+begin
+  Dest.Left:=floor(Src.Left+Offset.X);
+  Dest.Top:=floor(Src.Top+Offset.Y);
+  Dest.Right:=ceil(Src.Right+Offset.X);
+  Dest.Bottom:=ceil(Src.Bottom+Offset.Y);
+end;
+
 procedure FresnelPointsToPoints(const Src: TFresnelPointArray; out
   Dest: TPointArray);
 var
@@ -269,13 +282,24 @@ begin
   Canvas.Arc(aLeft,aTop,aRight,aBottom,AngleStart,AngleSweep);
 end;
 
+procedure TFresnelLCLRenderer.ClipRect(const aRect: TFresnelRect);
+var
+  r: TRect;
+begin
+  FresnelRectOffsetToRect(aRect,Origin,r);
+  Canvas.ClipRect:=r;
+  Canvas.Clipping:=true;
+end;
+
 procedure TFresnelLCLRenderer.FillRect(const aColor: TFPColor;
   const aRect: TFresnelRect);
+var
+  r: TRect;
 begin
   Canvas.Brush.FPColor:=aColor;
   Canvas.Brush.Style:=bsSolid;
-  Canvas.FillRect(Rect(floor(Origin.X+aRect.Left),floor(Origin.Y+aRect.Top),
-                       ceil(Origin.X+aRect.Right),ceil(Origin.Y+aRect.Bottom)));
+  FresnelRectOffsetToRect(aRect,Origin,r);
+  Canvas.FillRect(r);
 end;
 
 procedure TFresnelLCLRenderer.Line(const aColor: TFPColor; const x1, y1, x2,
@@ -286,6 +310,11 @@ begin
   Canvas.Line(round(Origin.X+x1),round(Origin.Y+y1),round(Origin.X+x2),round(Origin.Y+y2));
 end;
 
+procedure TFresnelLCLRenderer.Restore;
+begin
+  Canvas.RestoreHandleState;
+end;
+
 procedure TFresnelLCLRenderer.RoundRect(const aColor: TFPColor;
   const aRect: TFresnelRoundRect; Fill: Boolean);
 var
@@ -297,7 +326,7 @@ var
   p: TFresnelPointArray;
   Points: TPointArray;
 begin
-  FresnelRectToRect(aRect.Box,R);
+  FresnelRectOffsetToRect(aRect.Box,Origin,R);
   W:=R.Width;
   H:=R.Height;
   if (W<=0) or (H<=0) then exit;
@@ -346,6 +375,11 @@ begin
   end;
 end;
 
+procedure TFresnelLCLRenderer.Save;
+begin
+  Canvas.SaveHandleState;
+end;
+
 procedure TFresnelLCLRenderer.TextOut(const aLeft, aTop: TFresnelLength;
   const aFont: IFresnelFont; const aColor: TFPColor; const aText: string
   );

src/skia/fresnel.skiarenderer.pas

@@ -150,12 +150,15 @@ type
  Public
     procedure Arc(const aColor: TFPColor; const aCenter, aRadii: TFresnelPoint;
       aStartAngle: TFresnelLength = 0; aStopAngle: TFresnelLength = DoublePi); override;
+    procedure ClipRect(const aRect: TFresnelRect); override;
     procedure DrawImage(const aLeft, aTop, aWidth, aHeight: TFresnelLength;
       const aImage: TFPCustomImage); override;
     procedure FillRect(const aColor: TFPColor; const aRect: TFresnelRect); override;
     procedure Line(const aColor: TFPColor; const x1, y1, x2, y2: TFresnelLength); override;
+    procedure Restore; override;
     procedure RoundRect(const aColor: TFPColor; const aRect: TFresnelRoundRect;
       Fill: Boolean); override;
+    procedure Save; override;
     procedure TextOut(const aLeft, aTop: TFresnelLength;
       const aFont: IFresnelFont; const aColor: TFPColor;
       const aText: string); override;
@@ -800,6 +803,11 @@ begin
   Canvas.DrawLine(Origin.X+x1,Origin.Y+y1,Origin.X+x2,Origin.Y+y2, SkPaint);
 end;
 
+procedure TFresnelSkiaRenderer.Restore;
+begin
+  Canvas.Restore;
+end;
+
 procedure TFresnelSkiaRenderer.RoundRect(const aColor: TFPColor;
   const aRect: TFresnelRoundRect; Fill: Boolean);
 var
@@ -825,6 +833,11 @@ begin
   Canvas.DrawRoundRect(RoundR, SkPaint);
 end;
 
+procedure TFresnelSkiaRenderer.Save;
+begin
+  Canvas.Save;
+end;
+
 procedure TFresnelSkiaRenderer.TextOut(const aLeft, aTop: TFresnelLength;
   const aFont: IFresnelFont; const aColor: TFPColor; const aText: string);
 var
@@ -888,6 +901,14 @@ begin
   Canvas.DrawArc(Oval,SkStartAngle,SkSweepAngle,false,SkPaint);
 end;
 
+procedure TFresnelSkiaRenderer.ClipRect(const aRect: TFresnelRect);
+var
+  r: TRectF;
+begin
+  r:=RectF(aRect.Left+Origin.X,aRect.Top+Origin.Y,aRect.Right+Origin.X,aRect.Bottom+Origin.Y);
+  Canvas.ClipRect(r);
+end;
+
 constructor TFresnelSkiaRenderer.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);

src/wasm/fresnel.wasm.render.pp

@@ -50,6 +50,9 @@ Type
     procedure DrawImage(const aLeft, aTop, aWidth, aHeight: TFresnelLength; const aImage: TFPCustomImage); override;
     procedure DrawElBackground(El: TFresnelElement; Params: TBorderAndBackground); override;
     procedure DrawElBorder(El: TFresnelElement; Params: TBorderAndBackground); override;
+    procedure Save; override;
+    procedure Restore; override;
+    procedure ClipRect(const aRect: TFresnelRect); override;
   public
     constructor Create(AOwner: TComponent); override;
     property Canvas: TCanvasID read FCanvas write FCanvas;
@@ -339,6 +342,21 @@ begin
     end;
 end;
 
+procedure TWasmFresnelRenderer.Save;
+begin
+  // ToDo
+end;
+
+procedure TWasmFresnelRenderer.Restore;
+begin
+  // ToDo
+end;
+
+procedure TWasmFresnelRenderer.ClipRect(const aRect: TFresnelRect);
+begin
+  // ToDo
+end;
+
 constructor TWasmFresnelRenderer.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);