paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-11 10:20:53 +01:00
Code Issues Packages Projects Releases Wiki Activity

LCL, grids, don't scroll beyond max position, in trunk it only moves scrollbar but grid is without effect, in 1.2.6 this fixes index out of range while scrolling as reported in issue #25862

Browse Source 
git-svn-id: trunk@46565 -
This commit is contained in:
jesus 2014-10-16 04:07:00 +00:00
parent f4500475db
commit 9271bbf67f
1 changed files with 7 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
lcl/grids.pas
View File

@ -4280,7 +4280,7 @@ end;
procedure TCustomGrid.WMHScroll(var message: TLMHScroll);
var
C,TL,CTL,aPos: Integer;
C,TL,CTL,aPos, maxPos: Integer;
R: TRect;
ScrollInfo: TScrollInfo;
aCode: Smallint;
@ -4315,11 +4315,13 @@ begin
if not FGCache.ValidGrid or not HandleAllocated then
exit;
ScrollInfo.cbSize := SizeOf(ScrollInfo);
ScrollInfo.fMask := SIF_PAGE or SIF_RANGE;
GetScrollInfo(Handle, SB_HORZ, ScrollInfo);
maxPos := ScrollInfo.nMax - Max(ScrollInfo.nPage-1, 0);
aCode := message.ScrollCode;
if UseRightToLeftAlignment then begin
ScrollInfo.cbSize:=SizeOf(ScrollInfo);
ScrollInfo.fMask:= SIF_PAGE or SIF_RANGE;
GetScrollInfo(Handle, SB_HORZ, ScrollInfo);
aPos := (ScrollInfo.nMax-ScrollInfo.nPage)-Message.Pos;
case aCode of
SB_LINERIGHT: aCode := SB_LINELEFT;
@ -4350,7 +4352,7 @@ begin
SB_LINERIGHT: C := CTL + NextColWidth( FTopLeft.X, 1);
SB_LINELEFT: C := CTL - NextColWidth( FTopLeft.X - 1, -1);
// Scrolls one page of lines up / down
SB_PAGERIGHT: C := CTL + AccumColWidths(FGCache.FullVisibleGrid.Left, FGCache.FullVisibleGrid.Right);
SB_PAGERIGHT: C := min(maxPos, CTL + AccumColWidths(FGCache.FullVisibleGrid.Left, FGCache.FullVisibleGrid.Right));
SB_PAGELEFT: C := CTL - AccumColWidths(FGCache.FullVisibleGrid.Left, FGCache.FullVisibleGrid.Right);
// Scrolls to the current scroll bar position
SB_THUMBPOSITION: