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

win32: forward unhandled mousewheel messages to parent in order to support scrolling when mouse cursor is on child wincontrol.

Browse Source 
git-svn-id: trunk@52045 -
This commit is contained in:
ondrej 2016-03-24 15:24:14 +00:00
parent c6b63b7c3d
commit e9c686e804
3 changed files with 26 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/forms.pp
View File

@ -168,7 +168,6 @@ type
procedure WMSize(var Message: TLMSize); message LM_Size;
procedure WMHScroll(var Message : TLMHScroll); message LM_HScroll;
procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
procedure WMMouseWheel(var Message: TLMMouseEvent); message LM_MOUSEWHEEL;
procedure ComputeScrollbars; virtual;
procedure SetAutoScroll(Value: Boolean); virtual;
procedure Loaded; override;

12
lcl/include/scrollingwincontrol.inc
View File

@ -304,18 +304,6 @@ begin
HorzScrollbar.ScrollHandler(Message);
end;
procedure TScrollingWinControl.WMMouseWheel(var Message: TLMMouseEvent);
begin
// support VertScrollBar.Increment on Windows.
// The code has no meaning on other OS because scrolling is handled there directly by the OS
if Mouse.WheelScrollLines > 0 then
Message.WheelDelta :=
(Min(High(Message.WheelDelta), Max(Low(Message.WheelDelta),
(VertScrollBar.Increment * Message.WheelDelta))) div 120) * 120;
inherited WMMouseWheel(Message);
end;
constructor TScrollingWinControl.Create(TheOwner : TComponent);
begin
Inherited Create(TheOwner);

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

@ -165,6 +165,10 @@ var
ScrollMsg, ScrollBar: dword;
ScrollOffset: integer;
Pos: TPoint;
MouseMessage: TLMMouseEvent;
SW: TScrollingWinControl;
SB: TControlScrollBar;
ScrollWheelDelta: LongInt;
begin
if not TWinControl(Sender).HandleAllocated then
exit;
@ -208,15 +212,30 @@ var
ScrollBar := SB_VERT;
ScrollMsg := WM_VSCROLL;
end;
if Windows.GetScrollInfo(Handle, ScrollBar, ScrollInfo) then
if Windows.GetScrollInfo(Handle, ScrollBar, ScrollInfo)
and (Int64(ScrollInfo.nPage) < Int64(ScrollInfo.nMax)) then
begin
with TLMMouseEvent(Message) do
MouseMessage := TLMMouseEvent(Message);
begin
if Mouse.WheelScrollLines < 0 then
// -1 means, scroll one page
ScrollOffset := (WheelDelta * integer(ScrollInfo.nPage)) div 120
ScrollOffset := (MouseMessage.WheelDelta * integer(ScrollInfo.nPage)) div 120
else
ScrollOffset := (WheelDelta * Mouse.WheelScrollLines) div 120;
if Sender is TScrollingWinControl then // support scrollbar increment
begin
SW := TScrollingWinControl(Sender);
if ScrollBar = SB_Horz then
SB := SW.HorzScrollBar
else
SB := SW.VertScrollBar;
ScrollWheelDelta :=
(Min(High(MouseMessage.WheelDelta), Max(Low(MouseMessage.WheelDelta),
(SB.Increment * MouseMessage.WheelDelta))) div 120) * 120;
end else
ScrollWheelDelta := MouseMessage.WheelDelta;
begin
ScrollOffset := (ScrollWheelDelta * Mouse.WheelScrollLines) div 120;
end;
WParam := Windows.WParam(ScrollInfo.nPos - ScrollOffset);
if WParam > ScrollInfo.nMax - integer(ScrollInfo.nPage) + 1 then
WParam := ScrollInfo.nMax - integer(ScrollInfo.nPage) + 1;
@ -225,7 +244,9 @@ var
WParam := SB_THUMBPOSITION or (WParam shl 16);
end;
Windows.PostMessage(Handle, ScrollMsg, WParam, HWND(nil));
end;
end else
if (TControl(Sender).Parent <> nil) then
TControl(Sender).Parent.WindowProc(TLMessage(Message));
end;
begin