From be5322bd6d4bf011b3230b83b372b3226a80ee43 Mon Sep 17 00:00:00 2001 From: ondrej Date: Fri, 4 Mar 2016 06:06:04 +0000 Subject: [PATCH] lcl: fix overflows in mouse messages if mouse position exceeds smallint. Issue #29766 git-svn-id: trunk@51821 - --- lcl/controls.pp | 1 + lcl/include/control.inc | 53 ++++++++++++++++++---------- lcl/include/winapi.inc | 15 ++++++++ lcl/include/winapih.inc | 1 + lcl/include/wincontrol.inc | 7 ++-- lcl/interfaces/win32/win32winapi.inc | 5 ++- 6 files changed, 60 insertions(+), 22 deletions(-) diff --git a/lcl/controls.pp b/lcl/controls.pp index 454e14a6db..c59af073b4 100644 --- a/lcl/controls.pp +++ b/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; diff --git a/lcl/include/control.inc b/lcl/include/control.inc index 3957ad37da..5b8f3789a7 100644 --- a/lcl/include/control.inc +++ b/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; {------------------------------------------------------------------------------ diff --git a/lcl/include/winapi.inc b/lcl/include/winapi.inc index 9302751f7c..b8abcddc4f 100644 --- a/lcl/include/winapi.inc +++ b/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 diff --git a/lcl/include/winapih.inc b/lcl/include/winapih.inc index 34e8f17b11..be4d7251f7 100644 --- a/lcl/include/winapih.inc +++ b/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; diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index 65f4e5f514..9a5829b2ab 100644 --- a/lcl/include/wincontrol.inc +++ b/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} diff --git a/lcl/interfaces/win32/win32winapi.inc b/lcl/interfaces/win32/win32winapi.inc index 8c4a6463c0..33046898a6 100644 --- a/lcl/interfaces/win32/win32winapi.inc +++ b/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