diff --git a/lcl/controls.pp b/lcl/controls.pp index dc44cc1f3c..ed8cf92f46 100644 --- a/lcl/controls.pp +++ b/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 := []; diff --git a/lcl/include/control.inc b/lcl/include/control.inc index efa2520e16..3957ad37da 100644 --- a/lcl/include/control.inc +++ b/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: diff --git a/lcl/lmessages.pp b/lcl/lmessages.pp index b39a8eb93c..aef036d5de 100644 --- a/lcl/lmessages.pp +++ b/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}