paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-31 08:00:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: TShellCtrl: fixed slow checking for duplicates, bug #27473

Browse Source 
git-svn-id: branches/fixes_1_4@47793 -
This commit is contained in:
mattias 2015-02-15 00:38:18 +00:00
parent d44092b7c4
commit 9fde45a0a1
1 changed files with 27 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
lcl/shellctrls.pas
View File

@ -20,7 +20,7 @@ unit ShellCtrls;
interface
uses
Classes, SysUtils, Forms, Graphics, LCLType,
Classes, SysUtils, Forms, Graphics, LCLType, AvgLvlTree,
ComCtrls, FileUtil, LazUtf8;
{$if defined(Windows) or defined(darwin)}
@ -552,6 +552,11 @@ begin
end;
function STVCompareFiles(f1, f2: Pointer): integer;
begin
Result:=CompareFilenames(AnsiString(f1),AnsiString(f2));
end;
{ Helper routine.
Finds all files/directories directly inside a directory.
Does not recurse inside subdirectories.
@ -572,6 +577,9 @@ var
FileItem: TFileItem;
i: Integer;
MaskStrings: TStringList;
FileTree: TAvgLvlTree;
ShortFilename: AnsiString;
j: Integer;
{$if defined(windows) and not defined(wince)}
ErrMode : LongWord;
{$endif}
@ -590,6 +598,7 @@ begin
// The string list implements support for multiple masks separated
// by semi-comma ";"
MaskStrings := TStringList.Create;
FileTree:=TAvgLvlTree.Create(@STVCompareFiles);
try
MaskStrings.Delimiter := ';';
MaskStrings.DelimitedText := MaskStr;
@ -597,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 "
@ -606,11 +616,18 @@ 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);
IsValidDirectory := (DirInfo.Name <> '.') and (DirInfo.Name <> '..');
IsValidDirectory := (ShortFilename <> '.') and (ShortFilename <> '..');
IsHidden := (DirInfo.Attr and faHidden = faHidden);
//LinuxToWinAttr already does this in FF/FN
@ -636,8 +653,12 @@ begin
// Mark if it is a directory (ObjectData <> nil)
if IsDirectory then ObjectData := AResult
else ObjectData := nil;
if AResult.IndexOf(DirInfo.Name) < 0 then // From patch from bug 17761: TShellListView Mask: duplicated items if mask is " *.ext;*.ext "
AResult.AddObject(DirInfo.Name, ObjectData)
if FileTree.Find(Pointer(ShortFilename))=nil then
begin
// From patch from bug 17761: TShellListView Mask: duplicated items if mask is " *.ext;*.ext "
FileTree.Add(Pointer(ShortFilename));
AResult.AddObject(ShortFilename, ObjectData);
end;
end else
Files.Add ( TFileItem.Create(DirInfo));
end;
@ -648,6 +669,7 @@ begin
FindCloseUTF8(DirInfo);
end;
finally
FileTree.Free;
MaskStrings.Free;
end;