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

LCL: TShellCtrl: less calling ProcessMessages

Browse Source 
git-svn-id: trunk@47792 -
This commit is contained in:
mattias 2015-02-15 00:37:24 +00:00
parent 79346fc245
commit 442759f8f3
1 changed files with 9 additions and 1 deletions

10
lcl/shellctrls.pas
View File

@ -579,6 +579,7 @@ var
MaskStrings: TStringList;
FileTree: TAvgLvlTree;
ShortFilename: AnsiString;
j: Integer;
{$if defined(windows) and not defined(wince)}
ErrMode : LongWord;
{$endif}
@ -605,6 +606,7 @@ begin
if AFileSortType=fstNone then Files:=nil
else Files:=TList.Create;
j:=0;
for i := 0 to MaskStrings.Count - 1 do
begin
if MaskStrings.IndexOf(MaskStrings[i]) < i then Continue; // From patch from bug 17761: TShellListView Mask: duplicated items if mask is " *.ext;*.ext "
@ -614,7 +616,13 @@ begin
while FindResult = 0 do
begin
Application.ProcessMessages;
inc(j);
if j=100 then
begin
Application.ProcessMessages;
j:=0;
end;
ShortFilename := DirInfo.Name;
IsDirectory := (DirInfo.Attr and FaDirectory = FaDirectory);