lcl: fix overflows in mouse messages if mouse position exceeds smallint. Issue #29766

git-svn-id: trunk@51821 -

lcl/controls.pp

@@ -1330,6 +1330,7 @@ type
     procedure DblClick; virtual;
     procedure TripleClick; virtual;
     procedure QuadClick; virtual;
+    function GetMousePosFromMessage(const MessageMousePos: TSmallPoint): TPoint;
     procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); virtual;
     procedure MouseMove(Shift: TShiftState; X,Y: Integer); virtual;
     procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); virtual;

lcl/include/control.inc

@@ -1762,6 +1762,17 @@ begin
   Result := (Parent<>nil) and Parent.HandleAllocated and (GetCaptureControl = Self);
 end;
 
+function TControl.GetMousePosFromMessage(const MessageMousePos: TSmallPoint
+  ): TPoint;
+begin
+  if (Width>High(SmallInt)) or (Height>High(SmallInt)) then
+  begin
+    GetCursorPos(Result);
+    Result := ScreenToClient(Result);
+  end else
+    Result := SmallPointToPoint(MessageMousePos);
+end;
+
 function TControl.GetTBDockHeight: Integer;
 begin
   if FTBDockHeight>0 then
@@ -2124,11 +2135,14 @@ end;
 ------------------------------------------------------------------------------}
 procedure TControl.DoMouseDown(var Message: TLMMouse; Button: TMouseButton;
   Shift: TShiftState);
+var
+  MP: TPoint;
 begin
   //DebugLn('TControl.DoMouseDown ',DbgSName(Self),' ');
-  if not (csNoStdEvents in ControlStyle) then begin
-    with Message do
-      MouseDown(Button, KeysToShiftState(Keys) + Shift, XPos, YPos);
+  if not (csNoStdEvents in ControlStyle) then
+  begin
+    MP := GetMousePosFromMessage(Message.Pos);
+    MouseDown(Button, KeysToShiftState(Message.Keys) + Shift, MP.X, MP.Y);
   end;
 end;
 
@@ -2137,19 +2151,19 @@ end;
 ------------------------------------------------------------------------------}
 procedure TControl.DoMouseUp(var Message: TLMMouse; Button: TMouseButton);
 var
-  P: TPoint;
+  P, MP: TPoint;
 begin
   if not (csNoStdEvents in ControlStyle) then
-    with Message do
+  begin
+    MP := GetMousePosFromMessage(Message.Pos);
+    if (Button in [mbLeft, mbRight]) and DragManager.IsDragging then
     begin
-      if (Button in [mbLeft, mbRight]) and DragManager.IsDragging then
-      begin
-        P := ClientToScreen(Point(XPos, YPos));
-        DragManager.MouseUp(Button, KeysToShiftState(Keys), P.X, P.Y);
-        Message.Result := 1;
-      end;
-      MouseUp(Button, KeysToShiftState(Keys), XPos, YPos);
+      P := ClientToScreen(MP);
+      DragManager.MouseUp(Button, KeysToShiftState(Message.Keys), P.X, P.Y);
+      Message.Result := 1;
     end;
+    MouseUp(Button, KeysToShiftState(Message.Keys), MP.X, MP.Y);
+  end;
 end;
 
 {------------------------------------------------------------------------------
@@ -2217,7 +2231,7 @@ var
   Handled: Boolean;
 begin
   if (csDesigning in ComponentState) or (Message.Result <> 0) then Exit;
-  P := SmallPointToPoint(Message.Pos);
+  P := GetMousePosFromMessage(Message.Pos);
   // X and Y = -1 when user clicks on keyboard menu button
   if P.X <> -1 then
     P := ScreenToClient(P);
@@ -2585,7 +2599,7 @@ begin
   begin
     Exclude(FControlState, csClicked);
     //DebugLn('TControl.WMLButtonUp B ',dbgs(ClientRect.Left),',',dbgs(ClientRect.Top),',',dbgs(ClientRect.Right),',',dbgs(ClientRect.Bottom),' ',dbgs(Message.Pos.X),',',dbgs(Message.Pos.Y));
-    if PtInRect(ClientRect, SmallPointToPoint(Message.Pos))
+    if PtInRect(ClientRect, GetMousePosFromMessage(Message.Pos))
     then begin
       //DebugLn('TControl.WMLButtonUp C');
       Click;
@@ -2669,8 +2683,7 @@ var
   MousePos: TPoint;
   lState: TShiftState;
 begin
-  MousePos.X := Message.X;
-  MousePos.Y := Message.Y;
+  MousePos := GetMousePosFromMessage(SmallPoint(Message.X, Message.Y));
 
   lState := Message.State - [ssCaps, ssNum, ssScroll]; // Remove unreliable states, see http://bugs.freepascal.org/view.php?id=20065
   if DoMouseWheel(lState, Message.WheelDelta, MousePos) then
@@ -4132,14 +4145,16 @@ end;
   TControl WMMouseMove
 ------------------------------------------------------------------------------}
 procedure TControl.WMMouseMove(var Message: TLMMouseMove);
+var
+  MP: TPoint;
 begin
   {$IFDEF VerboseMouseBugfix}
   DebugLn(['[TControl.WMMouseMove] ',Name,':',ClassName,' ',Message.XPos,',',Message.YPos]);
   {$ENDIF}
-  UpdateMouseCursor(Message.XPos,Message.YPos);
+  MP := GetMousePosFromMessage(Message.Pos);
+  UpdateMouseCursor(MP.X,MP.Y);
   if not (csNoStdEvents in ControlStyle) then
-    with Message do
-      MouseMove(KeystoShiftState(Word(Keys)), XPos, YPos);
+    MouseMove(KeystoShiftState(Word(Message.Keys)), MP.X, MP.Y);
 end;
 
 {------------------------------------------------------------------------------

lcl/include/winapi.inc

@@ -1532,6 +1532,21 @@ begin
   Result.Y := P.Y;
 end;
 
+{------------------------------------------------------------------------------
+  Function: PointToSmallPointNoChecks
+  Params:
+  Returns:
+
+ ------------------------------------------------------------------------------}
+function PointToSmallPointNoChecks(const P : TPoint) : TSmallPoint; inline;
+begin
+  {$PUSH}
+  {$R-}{$Q-} // no range, no overflow checks
+  Result.X := P.X;
+  Result.Y := P.Y;
+  {$POP}
+end;
+
 {------------------------------------------------------------------------------
   Function: PtInRect
   Params:  Rect

lcl/include/winapih.inc

@@ -338,6 +338,7 @@ function OffsetRect(var Rect: TRect; dx,dy: Integer): Boolean; inline;
 
 function PtInRect(const Rect : TRect; const Point : TPoint) : Boolean; inline;
 function PointToSmallPoint(const P : TPoint) : TSmallPoint; inline;
+function PointToSmallPointNoChecks(const P : TPoint) : TSmallPoint; inline;
 
 function RGB(R, G, B : Byte) : TColorRef; inline;
 

lcl/include/wincontrol.inc

@@ -4702,8 +4702,11 @@ begin
     if MouseMessage.Msg = LM_MOUSEWHEEL then
     begin
       MouseEventMessage := TLMMouseEvent(TheMessage);
+      {$PUSH}
+      {$R-}{$Q-} // no range, no overflow checks
       MouseEventMessage.X := P.X;
       MouseEventMessage.Y := P.Y;
+      {$POP}
       Control.Dispatch(MouseEventMessage);
       MouseMessage.Result := MouseEventMessage.Result;
       Result := (MouseMessage.Result <> 0);
@@ -4711,7 +4714,7 @@ begin
     else
     begin
       MouseMessage.Result := Control.Perform(MouseMessage.Msg, WParam(MouseMessage.Keys),
-                             LParam(Integer(PointToSmallPoint(P))));
+                             LParam(Integer(PointToSmallPointNoChecks(P))));
       Result := True;
     end;
   end;
@@ -5133,7 +5136,7 @@ var
               (Enabled or (capfAllowDisabled in Flags))
               and
               (Perform(CM_HITTEST, 0,
-                       LParam(Integer(PointToSmallPoint(ControlPos)))) <> 0)
+                       LParam(Integer(PointToSmallPointNoChecks(ControlPos)))) <> 0)
              )
             );
       {$IFDEF VerboseMouseBugfix}

lcl/interfaces/win32/win32winapi.inc

@@ -176,11 +176,14 @@ var
       Pos.Y := Y;
     end;
     ClientToScreen(Handle, Pos);
-    WParam := Windows.WParam(Longint(PointToSmallPoint(Pos)));
+    WParam := Windows.WParam(Longint(PointToSmallPointNoChecks(Pos)));
     with TLMMouseEvent(Message) do
     begin
+      {$PUSH}
+      {$R-}{$Q-} // no range, no overflow checks
       X := Pos.X;
       Y := Pos.Y;
+      {$POP}
     end;
 
     with TLMessage(Message) do