* fixed wheelmouse scrolling

git-svn-id: trunk@7687 -
This commit is contained in:
marc 2005-09-13 17:31:01 +00:00
parent bc6b4b5817
commit 64e7faabb8

View File

@ -419,49 +419,81 @@ 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
then begin
LMessage.Msg := LM_CHANGED; LMessage.Msg := LM_CHANGED;
Exit;
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
// Retrieve the real position, ScrollInfo.fMask := SIF_POS;
ScrollInfo.cbSize := SizeOf(ScrollInfo); // older windows versions may not support trackpos, so fill it with some default
// ScrollInfo.nPos := Hi(WParam);
if Lo(WParam) = SB_ENDSCROLL end;
then begin
// Windows doesn't give a pos on endscroll. We will provide one
// Don't know if there is any code relying on this
ScrollInfo.fMask := SIF_POS;
end
else begin
ScrollInfo.fMask := SIF_TRACKPOS;
// older windows doesn't support trackpos, so fill it with some default
ScrollInfo.nTrackPos := Hi(WParam);
end;
if ScrollbarHandle <> 0 if ScrollbarHandle <> 0
then begin then begin
// The message is send by a scrollbar // The message is send by a scrollbar
GetScrollInfo(ScrollbarHandle, SB_CTL, ScrollInfo); GetScrollInfo(ScrollbarHandle, SB_CTL, ScrollInfo);
end end
else begin else begin
// The message is send by a window's standard scrollbar // The message is send by a window's standard scrollbar
if LMsg = LM_HSCROLL if LMsg = LM_HSCROLL
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
if Pos < High(SmallPos) // messages, but only when scroll.max < 32K. So in that case
then SmallPos := Pos // Hi(WParam) won't cycle.
else SmallPos := High(SmallPos); // When ending scrollbar tracking we also get those
ScrollBar := ScrollbarHandle; // messages. Now Hi(WParam) is cycling.
end; // 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)
then SmallPos := Pos
else SmallPos := High(SmallPos);
end; end;
end; end;