lcl: unify multiclick mouse message handling for all widgetsets

git-svn-id: trunk@51722 -

lcl/controls.pp

@@ -2614,6 +2614,10 @@ procedure GetCursorValues(Proc: TGetStrProc);
 function CursorToIdent(Cursor: Longint; var Ident: string): Boolean;
 function IdentToCursor(const Ident: string; var Cursor: Longint): Boolean;
 
+function CheckMouseButtonDownUp(const AWinControl: TWinControl;
+  var LastMouse: TLastMouseInfo; const AMousePos: TPoint; const AButton: Byte;
+  const AMouseDown: Boolean): Cardinal;
+
 // shiftstate
 function GetKeyShiftState: TShiftState;
 
@@ -2931,6 +2935,106 @@ begin
   MoveWindowOrgEx(DC,X,Y);
 end;
 
+function CheckMouseButtonDownUp(const AWinControl: TWinControl;
+  var LastMouse: TLastMouseInfo; const AMousePos: TPoint; const AButton: Byte;
+  const AMouseDown: Boolean): Cardinal;
+const
+  DblClickThreshold = 3;// max Movement between two clicks of a DblClick
+
+  // array of clickcount x buttontype
+  MSGKINDDOWN: array[1..4, 1..4] of Integer =
+  (
+    (LM_LBUTTONDOWN, LM_LBUTTONDBLCLK, LM_LBUTTONTRIPLECLK, LM_LBUTTONQUADCLK),
+    (LM_RBUTTONDOWN, LM_RBUTTONDBLCLK, LM_RBUTTONTRIPLECLK, LM_RBUTTONQUADCLK),
+    (LM_MBUTTONDOWN, LM_MBUTTONDBLCLK, LM_MBUTTONTRIPLECLK, LM_MBUTTONQUADCLK),
+    (LM_XBUTTONDOWN, LM_XBUTTONDBLCLK, LM_XBUTTONTRIPLECLK, LM_XBUTTONQUADCLK)
+  );
+  MSGKINDUP: array[1..4] of Integer =
+    (LM_LBUTTONUP, LM_RBUTTONUP, LM_MBUTTONUP, LM_XBUTTONUP);
+
+  function LastClickInSameWinControl: boolean;
+  begin
+    Result := (LastMouse.WinControl <> nil) and
+              (LastMouse.WinControl = AWinControl);
+  end;
+
+  function LastClickAtSamePosition: boolean;
+  begin
+    Result:= (Abs(AMousePos.X-LastMouse.MousePos.X) <= DblClickThreshold) and
+             (Abs(AMousePos.Y-LastMouse.MousePos.Y) <= DblClickThreshold);
+  end;
+
+  function LastClickInTime: boolean;
+  begin
+    Result:=((GetTickCount64 - LastMouse.Time) <= GetDoubleClickTime);
+  end;
+
+  function LastClickSameButton: boolean;
+  begin
+    Result:=(AButton=LastMouse.Button);
+  end;
+
+  function TestIfMultiClickDown: boolean;
+  begin
+    Result:= LastClickInSameWinControl and
+             LastClickAtSamePosition and
+             LastClickInTime and
+             LastClickSameButton;
+  end;
+
+  function TestIfMultiClickUp: boolean;
+  begin
+    Result:= LastClickInSameWinControl and
+             LastClickAtSamePosition and
+             LastClickSameButton;
+  end;
+
+var
+  IsMultiClick: boolean;
+begin
+  Result := LM_NULL;
+
+  if AMouseDown then
+    IsMultiClick := TestIfMultiClickDown
+  else
+    IsMultiClick := TestIfMultiClickUp;
+
+  if AMouseDown then
+  begin
+    inc(LastMouse.ClickCount);
+
+    if (LastMouse.ClickCount <= 4) and IsMultiClick then
+    begin
+      // multi click
+    end else
+    begin
+      // normal click
+      LastMouse.ClickCount:=1;
+    end;
+
+    LastMouse.Time := GetTickCount64;
+    LastMouse.MousePos := AMousePos;
+    LastMouse.WinControl := AWinControl;
+    LastMouse.Button := AButton;
+  end else
+  begin // mouse up
+    if not IsMultiClick then
+      LastMouse.ClickCount := 1;
+  end;
+
+  case LastMouse.ClickCount of
+    2: if not(csDoubleClicks in AWinControl.ControlStyle) then LastMouse.ClickCount := 1;
+    3: if not(csTripleClicks in AWinControl.ControlStyle) then LastMouse.ClickCount := 1;
+    4: if not(csQuadClicks in AWinControl.ControlStyle) then LastMouse.ClickCount := 1;
+  end;
+  LastMouse.Down := AMouseDown;
+
+  if AMouseDown then
+    Result := MSGKINDDOWN[AButton][LastMouse.ClickCount]
+  else
+    Result := MSGKINDUP[AButton];
+end;
+
 function GetKeyShiftState: TShiftState;
 begin
   Result := [];

lcl/include/control.inc

@@ -2048,36 +2048,6 @@ begin
   or ((TheMessage.Msg>=LM_MOUSEFIRST2) and (TheMessage.Msg<=LM_MOUSELAST2))
   then begin
     // mouse messages
-    
-    // map double clicks for controls, that do not want doubleclicks
-    if not (csDoubleClicks in ControlStyle) then
-    begin
-      case TheMessage.Msg of
-        LM_LButtonDBLCLK,
-        LM_RButtonDBLCLK,
-        LM_MButtonDBLCLK:
-          Dec(TheMessage.Msg, LM_LBUTTONDBLCLK - LM_LBUTTONDOWN);
-      end;
-    end;
-    // map triple clicks for controls, that do not want tripleclicks
-    if not (csTripleClicks in ControlStyle) then
-    begin
-      case TheMessage.Msg of
-        LM_LBUTTONTRIPLECLK: TheMessage.Msg:=LM_LBUTTONDOWN;
-        LM_MBUTTONTRIPLECLK: TheMessage.Msg:=LM_MBUTTONDOWN;
-        LM_RBUTTONTRIPLECLK: TheMessage.Msg:=LM_RBUTTONDOWN;
-      end;
-    end;
-    // map quad clicks for controls, that do not want quadclicks
-    if not (csQuadClicks in ControlStyle) then
-    begin
-      case TheMessage.Msg of
-        LM_LBUTTONQUADCLK: TheMessage.Msg:=LM_LBUTTONDBLCLK;
-        LM_MBUTTONQUADCLK: TheMessage.Msg:=LM_MBUTTONDBLCLK;
-        LM_RBUTTONQUADCLK: TheMessage.Msg:=LM_RBUTTONDBLCLK;
-      end;
-    end;
-
     case TheMessage.Msg of
 
       LM_MOUSEMOVE:

lcl/lmessages.pp

@@ -627,6 +627,15 @@ type
   TLMMButtonUp = TLMMouse;
   TLMXButtonUp = TLMMouse;
 
+  TLastMouseInfo = record
+    WinControl: TObject;
+    MousePos: TPoint;
+    Time: QWord;
+    ClickCount: Integer;
+    Button: Byte; // 1=left, 2=right, 3=middle, 4=Extra
+    Down: Boolean;
+  end;
+
   TLMSetFocus = record
     Msg: Cardinal;
 {$ifdef cpu64}