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

* fixed wheelmouse scrolling

Browse Source 
git-svn-id: trunk@7687 -
This commit is contained in:
marc 2005-09-13 17:31:01 +00:00
parent bc6b4b5817
commit 64e7faabb8
1 changed files with 71 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -419,23 +419,36 @@ Var
ScrollbarHandle := HWND(LParam); ScrollbarHandle := HWND(LParam);
if ScrollbarHandle<>0 then if ScrollbarHandle<>0 then
lWinControl := GetWindowInfo(ScrollbarHandle)^.WinControl; lWinControl := GetWindowInfo(ScrollbarHandle)^.WinControl;
if lWinControl is TCustomTrackBar then begin if lWinControl is TCustomTrackBar
LMessage.Msg := LM_CHANGED;
end
else begin
// Retrieve the real position,
ScrollInfo.cbSize := SizeOf(ScrollInfo);
//
if Lo(WParam) = SB_ENDSCROLL
then begin then begin
// Windows doesn't give a pos on endscroll. We will provide one LMessage.Msg := LM_CHANGED;
// Don't know if there is any code relying on this Exit;
ScrollInfo.fMask := SIF_POS; end;
PLMsg:=@LMScroll;
with LMScroll do
begin
Msg := LMsg;
ScrollCode := SmallInt(Lo(WParam));
SmallPos := 0;
ScrollBar := ScrollbarHandle;
Pos := 0;
end;
if not (Lo(WParam) in [SB_THUMBTRACK, SB_THUMBPOSITION]) then Exit;
// For thumb messges, retrieve the real position,
ScrollInfo.cbSize := SizeOf(ScrollInfo);
if Lo(WParam) = SB_THUMBTRACK
then begin
ScrollInfo.fMask := SIF_TRACKPOS;
// older windows versions may not support trackpos, so fill it with some default
ScrollInfo.nTrackPos := Hi(WParam);
end end
else begin else begin
ScrollInfo.fMask := SIF_TRACKPOS; ScrollInfo.fMask := SIF_POS;
// older windows doesn't support trackpos, so fill it with some default // older windows versions may not support trackpos, so fill it with some default
ScrollInfo.nTrackPos := Hi(WParam); ScrollInfo.nPos := Hi(WParam);
end; end;
if ScrollbarHandle <> 0 if ScrollbarHandle <> 0
@ -449,19 +462,38 @@ Var
then GetScrollInfo(Window, SB_HORZ, ScrollInfo) then GetScrollInfo(Window, SB_HORZ, ScrollInfo)
else GetScrollInfo(Window, SB_VERT, ScrollInfo); else GetScrollInfo(Window, SB_VERT, ScrollInfo);
end; end;
PLMsg:=@LMScroll;
with LMScroll do with LMScroll do
begin begin
Msg := LMsg; if Lo(WParam) = SB_THUMBTRACK
ScrollCode := SmallInt(Lo(WParam)); then Pos := ScrollInfo.nTrackPos
if ScrollCode = SB_ENDSCROLL else Pos := (ScrollInfo.nPos and $FFFF0000) or Hi(WParam);
then Pos := ScrollInfo.nPos // Note on the above
else Pos := ScrollInfo.nTrackPos; // When using the scrollwheel, windows sends SB_THUMBTRACK
// messages, but only when scroll.max < 32K. So in that case
// Hi(WParam) won't cycle.
// When ending scrollbar tracking we also get those
// messages. Now Hi(WParam) is cycling.
// To get the correct value you need to use GetScrollInfo.
//
// Now there is a problem. GetScrollInfo returns the old position
// while using the wheelmouse, and during tracking it returns
// the new position.
// To get around this, I use the most significant part of the
// value returned by ScrollInfo, since that is always correct
// The missing least significant part is given by Hi(WParam)
// (since it is cycling) and is also always valid.
// So the combination of both also is.
// In the case of the wheelmouse this only works if the
// difference between the old pos and the new pos is < 64K.
// I think we safely can asuume that (you wont get messages
// anyhow if the range was > 32K :).
// MWE.
if Pos < High(SmallPos) if Pos < High(SmallPos)
then SmallPos := Pos then SmallPos := Pos
else SmallPos := High(SmallPos); else SmallPos := High(SmallPos);
ScrollBar := ScrollbarHandle;
end;
end; end;
end; end;