lcl: mouse capture

src/base/fresnel.dom.pas

@@ -1530,6 +1530,7 @@ type
     Function DispatchEvent(aEvent : TAbstractEvent) : Integer;
     procedure SetPointerCapture(const aPointerId: TFreHandle); virtual;
     procedure ReleasePointerCapture(const aPointerId: TFreHandle); virtual;
+    function HasPointerCapture(const aPointerId: TFreHandle): boolean; virtual;
     property EventDispatcher: TFresnelEventDispatcher Read FEventDispatcher;
     // Font
     property Font: IFresnelFont read GetFont write FFont;
@@ -1608,7 +1609,7 @@ type
     MouseDownHit: THit;
     MouseDownPosition, MouseDownGrabPos: TFresnelLength;
     constructor Create(TheElement: TFresnelElement; aHorizontal: boolean); overload;
-    function GetHit(const X, Y: TFresnelLength; Nearest: boolean; out aPosition: TFresnelLength): THit; virtual; abstract;
+    function GetHit(const X, Y: TFresnelLength; out aPosition: TFresnelLength): THit; virtual; abstract;
     property Horizontal: boolean read FHorizontal;
   end;
 
@@ -7244,6 +7245,9 @@ begin
   for i:=0 to length(FPointerCaptures)-1 do
     if FPointerCaptures[i].Id=aPointerId then
       exit(FPointerCaptures[i].Element);
+
+  // todo: check other forms
+
   Result:=nil;
 end;
 
@@ -7263,10 +7267,13 @@ begin
   if El=nil then
     raise Exception.Create('20250324190651');
   if (El=Self) or (El.Viewport=Self) then
+    // ok
   else
-    raise Exception.Create('20250324191044');
+    raise Exception.Create('20250324191044'); // not element of this viewport
+
   if aPointerId=nil then
-    raise Exception.Create('20250324190659');
+    exit; // no valid handle
+
   for i:=0 to length(FPointerCaptures)-1 do
     if FPointerCaptures[i].Id=aPointerId then
     begin
@@ -7442,7 +7449,6 @@ begin
     // these events have ClientPos and are affected by pointer capture
 
     CaptEl:=GetPointerCaptureEl(WSData.PointerId);
-    writeln('TFresnelViewport.WSMouseXY CaptEl=',DbgSName(CaptEl));
     if CaptEl<>nil then
       El:=CaptEl
     else if length(NewHoverElements)>0 then
@@ -9154,6 +9160,11 @@ begin
   Viewport.ReleasePointerCapture(Self,aPointerId);
 end;
 
+function TFresnelElement.HasPointerCapture(const aPointerId: TFreHandle): boolean;
+begin
+  Result:=Viewport.GetPointerCaptureEl(aPointerId)=Self;
+end;
+
 function TFresnelElement.GetFont: IFresnelFont;
 
   function GetViewportFontSize: TFresnelLength;

src/base/fresnel.renderer.pas

@@ -43,7 +43,7 @@ type
     constructor Create(AOwner: TComponent); override; overload;
     procedure Draw(Renderer: TFresnelRenderer); virtual;
     procedure DrawCorner(Renderer: TFresnelRenderer; const r: TFresnelRect); virtual;
-    function GetHit(const X, Y: TFresnelLength; Nearest: boolean; out aPosition: TFresnelLength): THit; override;
+    function GetHit(const X, Y: TFresnelLength; out aPosition: TFresnelLength): THit; override;
   end;
 
   { TFresnelRenderer }
@@ -423,7 +423,7 @@ begin
   evtMouseDown:
     if MouseEvt.Button=mbLeft then
     begin
-      MouseDownHit:=GetHit(X,Y,false,MouseDownGrabPos);
+      MouseDownHit:=GetHit(X,Y,MouseDownGrabPos);
       MouseDownPosition:=Position;
       {$IFDEF VerboseFresnelScrolling}
       writeln('TRendererScrollBar.MouseHandler Mouse Down ',Parent.Name,' Horz=',Horizontal,' Hit=',MouseDownHit,' p=',FloatToCSSStr(MouseDownGrabPos));
@@ -450,7 +450,7 @@ begin
   evtMouseMove:
     if (MouseEvt.Button=mbLeft) then
     begin
-      Hit:=GetHit(X,Y,true,p);
+      Hit:=GetHit(X,Y,p);
       {$IFDEF VerboseFresnelScrolling}
       writeln('TRendererScrollBar.MouseHandler Mouse Move ',Parent.Name,' Horz=',Horizontal,' Hit=',Hit,' p=',FloatToCSSStr(p),' GrabPos=',FloatToCSSStr(MouseDownGrabPos));
       {$ENDIF}
@@ -465,7 +465,7 @@ begin
   evtMouseUp:
     if (MouseEvt.Button=mbLeft) then
     begin
-      Hit:=GetHit(X,Y,true,p);
+      Hit:=GetHit(X,Y,p);
       {$IFDEF VerboseFresnelScrolling}
       writeln('TRendererScrollBar.MouseHandler Mouse Up ',Parent.Name,' Horz=',Horizontal,' Hit=',Hit,' p=',FloatToCSSStr(p));
       {$ENDIF}
@@ -555,8 +555,7 @@ begin
   Renderer.FillRect(TrackColor,r);
 end;
 
-function TRendererScrollBar.GetHit(const X, Y: TFresnelLength; Nearest: boolean; out
-  aPosition: TFresnelLength): THit;
+function TRendererScrollBar.GetHit(const X, Y: TFresnelLength; out aPosition: TFresnelLength): THit;
 var
   LT, RB: TFresnelLength;
 begin
@@ -564,15 +563,11 @@ begin
   aPosition:=0;
   if Horizontal then
   begin
-    if (not Nearest) and ((X<Box.Left) or (X>Box.Right)) then
-      exit;
     LT:=Box.Left+Border;
     RB:=Box.Right-Border;
     if LT>RB-1 then exit;
     aPosition:=(X-LT) / (RB-LT);
   end else begin
-    if (not Nearest) and ((Y<Box.Top) or (Y>Box.Bottom)) then
-      exit;
     LT:=Box.Top+Border;
     RB:=Box.Bottom-Border;
     if LT>RB-1 then exit;

src/lcl/fresnel.lcl.pas

@@ -157,6 +157,8 @@ type
     function GetClientSize: TFresnelPoint; override;
     procedure Invalidate; override;
     procedure InvalidateRect(const aRect: TFresnelRect); override;
+    procedure SetPointerCapture(const aPointerId: TFreHandle); override;
+    procedure ReleasePointerCapture(const aPointerId: TFreHandle); override;
     function CreateLCLForm: TForm; virtual;
     property LCLForm: TFresnelLCLForm read FLCLForm;
 
@@ -437,7 +439,7 @@ class procedure TLCLWSForm.InitMouseXYEvent(out EvtInit: TFresnelMouseEventInit;
 
 begin
   EvtInit:=Default(TFresnelMouseEventInit);
-  evtInit.Button:=Fresnel.Events.TMouseButton(Button);
+  EvtInit.Button:=Fresnel.Events.TMouseButton(Button);
   if ssLeft in Shift then
     Include(EvtInit.Buttons,mbLeft);
   if ssMiddle in Shift then
@@ -453,6 +455,7 @@ begin
   EvtInit.ViewportPos.Y:=Y;
   EvtInit.PagePos:=EvtInit.ViewportPos;
   EvtInit.Shiftstate:=Shift;
+  EvtInit.PointerId:=FresnelLCLWidgetSet;
 end;
 
 procedure TLCLWSForm.LCLMouseDown(Sender: TObject; Button: Controls.TMouseButton;
@@ -469,7 +472,6 @@ begin
   FresnelForm.WSResize(GetFormBounds,LCLForm.ClientWidth,LCLForm.ClientHeight);
 end;
 
-
 procedure TLCLWSForm.LCLMouseMove(Sender: TObject; Shift: TShiftState; X,
   Y: Integer);
 var
@@ -679,6 +681,20 @@ begin
   LCLIntf.InvalidateRect(LCLForm.Handle,@PixRect,false);
 end;
 
+procedure TLCLWSForm.SetPointerCapture(const aPointerId: TFreHandle);
+begin
+  if aPointerId<>TFreHandle(FresnelLCLWidgetSet) then exit;
+  SetCaptureControl(LCLForm);
+end;
+
+procedure TLCLWSForm.ReleasePointerCapture(const aPointerId: TFreHandle);
+begin
+  if aPointerId<>TFreHandle(FresnelLCLWidgetSet) then exit;
+  if (LCLForm=nil) or not LCLForm.HandleAllocated then exit;
+  if GetCaptureControl<>LCLForm then exit;
+  SetCaptureControl(nil);
+end;
+
 function TLCLWSForm.CreateLCLForm: TForm;
 var
   aFontEngine: TFresnelFontEngine;

src/lcl/fresnel.lclevents.pas

@@ -86,12 +86,12 @@ Var
   R : TFresnelRect;
 begin
   InitMouseEvent(aInit);
-  aEl:=Viewport.GetElementAt(aInit.PagePos.X,aInit.PagePos.Y);
+  aEl:=Viewport.GetElementAt(aInit.ViewportPos.X,aInit.ViewportPos.Y);
   if aEl=Nil then
     aEl:=FViewport;
   R:=aEL.GetBorderBoxOnViewport;
-  aInit.ControlPos.X:=aInit.PagePos.X-R.Left;
-  aInit.ControlPos.Y:=aInit.PagePos.Y-R.Top;
+  aInit.ClientPos.X:=aInit.ViewportPos.X-R.Left;
+  aInit.ClientPos.Y:=aInit.ViewportPos.Y-R.Top;
   evt:=aEl.EventDispatcher.CreateEvent(aEl,evtClick) as TFresnelMouseEvent;
   try
     evt.initEvent(aInit);