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

LCL: TShellCtrl: check for duplicates using avl tree

Browse Source 
git-svn-id: trunk@47791 -
This commit is contained in:
mattias 2015-02-15 00:34:49 +00:00
parent be6f83f647
commit 79346fc245
1 changed files with 18 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
lcl/shellctrls.pas
View File

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