started GetPointerCapture and LostPoinerCapture events

src/base/fresnel.classes.pas

@@ -195,6 +195,8 @@ Procedure FLLog(aType: TEventType; Const Fmt : string; Const Args : Array of con
 Procedure FLLog(aType: TEventType; const args : Array of string); overload;
 function DbgSName(const p: TObject): string; overload;
 function DbgSName(const p: TClass): string; overload;
+function dbgs(const p: TFresnelPoint): string; overload;
+function dbgs(const r: TFresnelRect): string; overload;
 
 Var
   MinStrokeWidth : TFresnelLength = 0.09;
@@ -356,6 +358,16 @@ begin
     Result:=p.ClassName;
 end;
 
+function dbgs(const p: TFresnelPoint): string;
+begin
+  Result:=FloatToStr(p.X)+','+FloatToStr(p.Y);
+end;
+
+function dbgs(const r: TFresnelRect): string;
+begin
+  Result:=FloatToStr(r.Left)+','+FloatToStr(r.Top)+','+FloatToStr(r.Right)+','+FloatToStr(r.Bottom);
+end;
+
 { TFresnelPoint }
 
 class function TFresnelPoint.Zero: TFresnelPoint;

src/base/fresnel.dom.pas

@@ -1678,7 +1678,8 @@ type
   protected
     FPointerCaptures: array of TFresnelVPPointerCapture;
     FVPApplication: IFresnelVPApplication;
-    procedure Bubble(lElement: TFresnelElement; lEvt: TFresnelEvent);
+    procedure Bubble(El: TFresnelElement; aEvt: TFresnelEvent);
+    procedure DispatchPointerCapture(El: TFresnelElement; Lost: boolean; const aPointerId: TFreHandle); virtual;
     function GetDPI(IsHorizontal: boolean): TFresnelLength; override;
     function GetHeight: TFresnelLength; virtual;
     function GetScrollbarsOverlay: boolean; virtual;
@@ -1827,8 +1828,6 @@ function FontVariantEastAsiansToStr(const FVEastAsians: TFresnelCSSFontVarEastAs
 function FontVariantLigaturesToStr(const FVLigatures: TFresnelCSSFontVarLigaturesSet): string;
 function FontVariantNumericsToStr(const FVNumerics: TFresnelCSSFontVarNumerics): string;
 
-function dbgs(const p: TFresnelPoint): string; overload;
-function dbgs(const r: TFresnelRect): string; overload;
 function dbgs(const c: TFPColor): string; overload;
 
 implementation
@@ -2011,16 +2010,6 @@ begin
   end;
 end;
 
-function dbgs(const p: TFresnelPoint): string;
-begin
-  Result:=FloatToStr(p.X)+','+FloatToStr(p.Y);
-end;
-
-function dbgs(const r: TFresnelRect): string;
-begin
-  Result:=FloatToStr(r.Left)+','+FloatToStr(r.Top)+','+FloatToStr(r.Right)+','+FloatToStr(r.Bottom);
-end;
-
 function dbgs(const c: TFPColor): string;
 
   function IsByte(w: word): boolean;
@@ -7234,16 +7223,21 @@ begin
       OldEl:=FPointerCaptures[i].Element;
       if OldEl=El then exit;
       // capture switches to another element
+
+      // loose old capture
       FPointerCaptures[i].Element:=nil;
       j:=length(FPointerCaptures)-1;
       while (j>=0) and (FPointerCaptures[j].Element<>OldEl) do dec(j);
       if j<0 then
         Exclude(OldEl.FStates,fesPointerCapture);
+      DispatchPointerCapture(OldEl,true,aPointerId); // might raise an exception
 
+      // get new capture
       FPointerCaptures[i].Element:=El;
       Include(El.FStates,fesPointerCapture);
       El.ViewportConnected:=true;
-      // todo: tell element is has lost the capture
+      DispatchPointerCapture(OldEl,false,aPointerId); // might raise an exception
+
       exit;
     end;
 
@@ -7254,6 +7248,8 @@ begin
   Include(El.FStates,fesPointerCapture);
   El.ViewportConnected:=true;
   SetPointerCapture(aPointerId);
+
+  DispatchPointerCapture(El,false,aPointerId); // might raise an exception
 end;
 
 procedure TFresnelViewport.ReleasePointerCapture(const aPointerId: TFreHandle);
@@ -7273,12 +7269,16 @@ begin
     begin
       // capturing this PointerId
       if FPointerCaptures[i].Element<>El then exit;
+
+      // loose capture
       System.Delete(FPointerCaptures,i,1);
       j:=length(FPointerCaptures)-1;
       while (j>=0) and (FPointerCaptures[j].Element<>El) do dec(j);
       if j<0 then
         Exclude(El.FStates,fesPointerCapture);
       ReleasePointerCapture(aPointerId);
+      DispatchPointerCapture(El,true,aPointerId); // might raise an exception
+
       exit;
     end;
 end;
@@ -7458,19 +7458,40 @@ begin
   end;
 end;
 
-procedure TFresnelViewport.Bubble(lElement : TFresnelElement; lEvt : TFresnelEvent);
+procedure TFresnelViewport.Bubble(El : TFresnelElement; aEvt : TFresnelEvent);
 
 begin
-  While lElement<>Nil do
+  While El<>Nil do
     begin
-    lEvt.Sender:=lElement;
-    lElement.DispatchEvent(lEvt);
-    if lEvt.PropagationStopped then
+    aEvt.Sender:=El;
+    El.DispatchEvent(aEvt);
+    if aEvt.PropagationStopped then
       exit;
-    lElement:=lElement.Parent;
+    El:=El.Parent;
     end;
 end;
 
+procedure TFresnelViewport.DispatchPointerCapture(El: TFresnelElement; Lost: boolean;
+  const aPointerId: TFreHandle);
+var
+  MouseData: TFresnelMouseEventInit;
+  PointerData: TFresnelPointerEventInit;
+  Evt: TFresnelPointerEvent;
+begin
+  MouseData:=Default(TFresnelMouseEventInit);
+  PointerData:=Default(TFresnelPointerEventInit);
+  PointerData.Id:=aPointerId;
+  if Lost then
+    Evt:=TFresnelLostPointerCapture.Create(MouseData,PointerData)
+  else
+    Evt:=TFresnelGetPointerCapture.Create(MouseData,PointerData);
+  try
+    El.DispatchEvent(Evt);
+  finally
+    Evt.Free;
+  end;
+end;
+
 function TFresnelViewport.WSKey(WSData: TFresnelKeyEventInit; KeyEventId: TEventID): boolean;
 
 var
@@ -7550,6 +7571,8 @@ begin
     R(TBubbleMouseMoveEvent);
     R(TFresnelMouseLeaveEvent);
     R(TFresnelMouseEnterEvent);
+    R(TFresnelGetPointerCapture);
+    R(TFresnelLostPointerCapture);
   end;
 end;
 

src/base/fresnel.events.pas

@@ -51,10 +51,12 @@ Const
   evtMouseEnter = 20;
   evtMouseLeave = 21;
   evtMouseWheel = 22;
-  evtFocusIn = 23;
-  evtFocusOut = 24;
-  evtFocus = 25;
-  evtBlur = 26;
+  evtGetPointerCapture = 23;
+  evtLostPointerCapture = 24;
+  evtFocusIn = 25;
+  evtFocusOut = 26;
+  evtFocus = 27;
+  evtBlur = 28;
 
 
   evtLastControlEvent = evtBlur;
@@ -194,11 +196,13 @@ Type
   { TFresnelMouseClickEvent }
 
   TFresnelMouseClickEvent = class(TFresnelPointerEvent)
+  public
     class function FresnelEventID : TEventID; override;
   end;
   TFLMouseClickEvent = TFresnelMouseClickEvent;
 
   TFresnelMouseDoubleClickEvent = class(TFresnelPointerEvent)
+  public
     class function FresnelEventID : TEventID; override;
   end;
   TFLMouseDoubleClickEvent = TFresnelMouseDoubleClickEvent;
@@ -206,6 +210,7 @@ Type
   { TFresnelMouseDownEvent }
 
   TFresnelMouseDownEvent = class(TFresnelPointerEvent)
+  public
     class function FresnelEventID : TEventID; override;
   end;
   TFLMouseDownEvent = TFresnelMouseDownEvent;
@@ -213,6 +218,7 @@ Type
   { TFresnelMouseMoveEvent }
 
   TFresnelMouseMoveEvent = class(TFresnelPointerEvent)
+  public
     class function FresnelEventID : TEventID; override;
   end;
   TFLMouseMoveEvent = TFresnelMouseMoveEvent;
@@ -220,6 +226,7 @@ Type
   { TFresnelMouseUpEvent }
 
   TFresnelMouseUpEvent = class(TFresnelMouseEvent)
+  public
     class function FresnelEventID : TEventID; override;
   end;
   TFLMouseUpEvent = TFresnelMouseUpEvent;
@@ -246,6 +253,22 @@ Type
   end;
   TFLMouseLeaveEvent = TFresnelMouseLeaveEvent;
 
+  { TFresnelGetPointerCapture }
+
+  TFresnelGetPointerCapture = class(TFresnelPointerEvent)
+  Public
+    class function FresnelEventID : TEventID; override;
+  end;
+  TFLGetPointerCaptureEvent = TFresnelGetPointerCapture;
+
+  { TFresnelLostPointerCapture }
+
+  TFresnelLostPointerCapture = class(TFresnelPointerEvent)
+  Public
+    class function FresnelEventID : TEventID; override;
+  end;
+  TFLLostPointerCaptureEvent = TFresnelLostPointerCapture;
+
   TFresnelKeyEventInit = Record
     // State of shift keys
     ShiftState : TShiftState;
@@ -284,6 +307,7 @@ Type
   { TFresnelKeyUpEvent }
 
   TFresnelKeyUpEvent = class(TFresnelKeyEvent)
+  public
     Class function FresnelEventID: TEventID; override;
   end;
   TFLKeyUpEvent = TFresnelKeyUpEvent;
@@ -291,6 +315,7 @@ Type
   { TFresnelKeyDownEvent }
 
   TFresnelKeyDownEvent = class(TFresnelKeyEvent)
+  public
     Class function FresnelEventID: TEventID; override;
   end;
   TFLDownEvent = TFresnelKeyDownEvent;
@@ -298,6 +323,7 @@ Type
   { TFresnelChangeEvent }
 
   TFresnelChangeEvent = class(TFresnelEvent)
+  public
     Class Function FresnelEventID: TEventID; override;
   end;
   TFLChangeEvent = TFresnelChangeEvent;
@@ -317,6 +343,7 @@ Type
   { TFresnelFocusInEvent }
 
   TFresnelFocusInEvent = Class(TFresnelFocusEvent)
+  public
     Class function FresnelEventID: TEventID; override;
   end;
   TFLFocusInEvent = TFresnelFocusInEvent;
@@ -324,6 +351,7 @@ Type
   { TFresnelFocusOutEvent }
 
   TFresnelFocusOutEvent = Class(TFresnelFocusEvent)
+  public
     Class function FresnelEventID: TEventID; override;
   end;
   TFLFocusOutEvent = TFresnelFocusOutEvent;
@@ -331,6 +359,7 @@ Type
   { TFresnelBlurEvent }
 
   TFresnelBlurEvent = Class(TFresnelUIEvent)
+  public
     Class function FresnelEventID: TEventID; override;
   end;
   TFLBlurEvent = TFresnelBlurEvent;
@@ -445,6 +474,8 @@ Const
     'MouseEnter',
     'MouseLeave',
     'MouseWheel',
+    'GetPointerCapture',
+    'LostPointerCapture',
     'FocusIn',
     'FocusOut',
     'Focus',
@@ -636,6 +667,20 @@ begin
   Result:=evtMouseLeave;
 end;
 
+{ TFresnelGetPointerCapture }
+
+class function TFresnelGetPointerCapture.FresnelEventID: TEventID;
+begin
+  Result:=evtGetPointerCapture;
+end;
+
+{ TFresnelLostPointerCapture }
+
+class function TFresnelLostPointerCapture.FresnelEventID: TEventID;
+begin
+  Result:=evtLostPointerCapture;
+end;
+
 { TFresnelEvent }
 
 class function TFresnelEvent.StandardEventName(aEventID : TEventID): TEventName;