paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 22:18:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: support VertScrollBar.Increment by scrollingwincontrol on Windows

Browse Source 
git-svn-id: trunk@50527 -
This commit is contained in:
ondrej 2015-11-29 22:21:49 +00:00
parent c87a82364e
commit 916bee86f8
2 changed files with 13 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/forms.pp
View File

@ -166,6 +166,7 @@ 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,6 +304,18 @@ 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);