paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-31 17:20:37 +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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
lcl/shellctrls.pas
View File

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