paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 21:19:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

win32: fix scroll message handling (there was an offset when sending unhandled messages to parent)

Browse Source 
git-svn-id: trunk@52424 -
This commit is contained in:
ondrej 2016-06-02 16:06:07 +00:00
parent e9b5d2925b
commit c3f246a2cb
2 changed files with 35 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/interfaces/win32/win32callback.inc
View File

@ -1637,6 +1637,7 @@ begin
Exit(True); Exit(True);
// the mousewheel message is for us // the mousewheel message is for us
Msg := LM_MOUSEWHEEL; Msg := LM_MOUSEWHEEL;
// important: LM_MOUSEWHEEL needs client coordinates (windows WM_MOUSEWHEEL are screen coordinates)
Windows.ScreenToClient(TargetWindow, P); Windows.ScreenToClient(TargetWindow, P);
X := P.X; X := P.X;
Y := P.Y; Y := P.Y;

82
lcl/interfaces/win32/win32winapi.inc
View File

@ -161,40 +161,28 @@ var
procedure CallMouseWheelHandler; procedure CallMouseWheelHandler;
var var
ScrollInfo: Windows.tagScrollInfo; ScrollInfo: Windows.tagScrollInfo;
WParam: Windows.WParam; SystemWParam: Windows.WParam;
ScrollMsg, ScrollBar: dword; ScrollMsg, ScrollBar: dword;
ScrollOffset: integer; ScrollOffset: integer;
Pos: TPoint; Pos: TPoint;
MouseMessage: TLMMouseEvent; MMessage: PLMMouseEvent;
SW: TScrollingWinControl; SW: TScrollingWinControl;
SB: TControlScrollBar; SB: TControlScrollBar;
begin begin
if not TWinControl(Sender).HandleAllocated then if not TWinControl(Sender).HandleAllocated then
exit; exit;
// why coords are client? - they must be screen // important: LM_MOUSEWHEEL needs client coordinates (windows WM_MOUSEWHEEL are screen coordinates)
with TLMMouseEvent(Message) do // do not modify original message
begin MMessage := @TLMMouseEvent(Message);
Pos.X := X; Pos.X := MMessage^.X;
Pos.Y := Y; Pos.Y := MMessage^.Y;
end;
ClientToScreen(Handle, Pos); ClientToScreen(Handle, Pos);
WParam := Windows.WParam(Longint(PointToSmallPointNoChecks(Pos))); SystemWParam := 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 MMessage^.Result := CallDefaultWindowProc(Handle, MMessage^.Msg, SystemWParam, TLMessage(Message).LParam);
begin // Windows handled it, so exit here.
Result := CallDefaultWindowProc(Handle, Msg, WParam, LParam); if MMessage^.Result<>0 then exit;
// Windows handled it, so exit here.
if Result<>0 then exit;
end;
// send scroll message // send scroll message
FillChar(ScrollInfo, sizeof(ScrollInfo), #0); FillChar(ScrollInfo, sizeof(ScrollInfo), #0);
@ -202,7 +190,7 @@ var
ScrollInfo.fMask := SIF_PAGE or SIF_POS or SIF_RANGE; ScrollInfo.fMask := SIF_PAGE or SIF_POS or SIF_RANGE;
// if mouse is over horizontal scrollbar, scroll horizontally // if mouse is over horizontal scrollbar, scroll horizontally
if Windows.SendMessage(Handle, WM_NCHITTEST, 0, WParam) = HTHSCROLL then if Windows.SendMessage(Handle, WM_NCHITTEST, 0, SystemWParam) = HTHSCROLL then
begin begin
ScrollBar := SB_HORZ; ScrollBar := SB_HORZ;
ScrollMsg := WM_HSCROLL; ScrollMsg := WM_HSCROLL;
@ -214,33 +202,31 @@ var
if Windows.GetScrollInfo(Handle, ScrollBar, ScrollInfo) if Windows.GetScrollInfo(Handle, ScrollBar, ScrollInfo)
and (Int64(ScrollInfo.nPage) < Int64(ScrollInfo.nMax)) then and (Int64(ScrollInfo.nPage) < Int64(ScrollInfo.nMax)) then
begin begin
MouseMessage := TLMMouseEvent(Message); if Mouse.WheelScrollLines < 0 then
// -1 means, scroll one page
ScrollOffset := (MMessage^.WheelDelta * integer(ScrollInfo.nPage)) div 120
else
if Sender is TScrollingWinControl then // support scrollbar increment
begin begin
if Mouse.WheelScrollLines < 0 then SW := TScrollingWinControl(Sender);
// -1 means, scroll one page if ScrollBar = SB_Horz then
ScrollOffset := (MouseMessage.WheelDelta * integer(ScrollInfo.nPage)) div 120 SB := SW.HorzScrollBar
else else
if Sender is TScrollingWinControl then // support scrollbar increment SB := SW.VertScrollBar;
begin ScrollOffset :=
SW := TScrollingWinControl(Sender); (Min(High(MMessage^.WheelDelta), Max(Low(MMessage^.WheelDelta),
if ScrollBar = SB_Horz then (SB.Increment * MMessage^.WheelDelta))) div 120);
SB := SW.HorzScrollBar end else
else ScrollOffset := (MMessage^.WheelDelta * Mouse.WheelScrollLines) div 120;
SB := SW.VertScrollBar;
ScrollOffset :=
(Min(High(MouseMessage.WheelDelta), Max(Low(MouseMessage.WheelDelta),
(SB.Increment * MouseMessage.WheelDelta))) div 120);
end else
ScrollOffset := (MouseMessage.WheelDelta * Mouse.WheelScrollLines) div 120;
WParam := Windows.WParam(ScrollInfo.nPos - ScrollOffset); SystemWParam := Windows.WParam(ScrollInfo.nPos - ScrollOffset);
if WParam > ScrollInfo.nMax - integer(ScrollInfo.nPage) + 1 then if SystemWParam > ScrollInfo.nMax - integer(ScrollInfo.nPage) + 1 then
WParam := ScrollInfo.nMax - integer(ScrollInfo.nPage) + 1; SystemWParam := ScrollInfo.nMax - integer(ScrollInfo.nPage) + 1;
if WParam < ScrollInfo.nMin then if SystemWParam < ScrollInfo.nMin then
WParam := ScrollInfo.nMin; SystemWParam := ScrollInfo.nMin;
WParam := SB_THUMBPOSITION or (WParam shl 16); SystemWParam := SB_THUMBPOSITION or (SystemWParam shl 16);
end;
Windows.PostMessage(Handle, ScrollMsg, WParam, HWND(nil)); Windows.PostMessage(Handle, ScrollMsg, SystemWParam, HWND(nil));
end else end else
if (TControl(Sender).Parent <> nil) then if (TControl(Sender).Parent <> nil) then
TControl(Sender).Parent.WindowProc(TLMessage(Message)); TControl(Sender).Parent.WindowProc(TLMessage(Message));