paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-05 19:57:14 +01:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Prevent scrolling in the default Widgetset implementation of ListBox.SelectRange. Fix off by 1 error. Part of issue #0036929.

Browse Source 
git-svn-id: trunk@63337 -
This commit is contained in:
bart 2020-06-10 09:52:40 +00:00
parent f0e8acae66
commit 703f17cf32
1 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
lcl/widgetset/wsstdctrls.pp
View File

@ -368,10 +368,17 @@ end;
class procedure TWSCustomListBox.SelectRange(const ACustomListBox: TCustomListBox;
ALow, AHigh: integer; ASelected: boolean);
var
i: Integer;
OldTopIndex, i: Integer;
begin // A default implementation. A widgetset can override it with a better one.
for i := ALow to AHigh - 1 do
SelectItem(ACustomListBox, i, ASelected);
OldTopIndex := ACustomListBox.TopIndex; //prevent scrolling to last Item selected on Windows, Issue #0036929
ACustomListBox.Items.BeginUpdate; //prevent visual update when selecting large ranges on Windows, Issue #0036929
try
for i := ALow to AHigh do
SelectItem(ACustomListBox, i, ASelected);
ACustomListBox.TopIndex := OldTopIndex;
finally
ACustomListBox.Items.EndUpdate;
end;
end;
class procedure TWSCustomListBox.SetBorder(const ACustomListBox: TCustomListBox);