paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 14:38:01 +02:00
Code Issues Packages Projects Releases Wiki Activity

Implements support for multiple masks separated by semi-comma in the shell controls. See bug #17222

Browse Source 
git-svn-id: trunk@27576 -
This commit is contained in:
sekelsenmat 2010-10-04 15:09:03 +00:00
parent aac4168119
commit d291ed049d
1 changed files with 62 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

106
lcl/shellctrls.pas
View File

@ -383,7 +383,11 @@ end;
{ Helper routine.
Finds all files/directories directly inside a directory.
Does not recurse inside subdirectories. }
Does not recurse inside subdirectories.
AMask may contain multiple file masks separated by ;
Don't add a final ; after the last mask.
}
class procedure TCustomShellTreeView.GetFilesInDir(const ABaseDir: string;
AMask: string; AObjectTypes: TObjectTypes; AResult: TStrings; AFileSortType: TFileSortType);
var
@ -392,10 +396,11 @@ var
IsDirectory, IsValidDirectory, IsHidden, AddFile: Boolean;
ObjectData: TObject;
SearchStr: string;
MaskStr: string;
CurMaskStr, MaskStr: string;
Files: TList;
FileItem: TFileItem;
i: Integer;
MaskStrings: TStringList;
{$if defined(windows) and not defined(wince)}
ErrMode : LongWord;
{$endif}
@ -411,54 +416,67 @@ begin
if Trim(AMask) = '' then MaskStr := AllFilesMask
else MaskStr := AMask;
if AFileSortType=fstNone then Files:=nil
else Files:=TList.Create;
// The string list implements support for multiple masks separated
// by semi-comma ";"
MaskStrings := TStringList.Create;
try
MaskStrings.Delimiter := ';';
MaskStrings.DelimitedText := MaskStr;
SearchStr := IncludeTrailingPathDelimiter(ABaseDir) + MaskStr;
if AFileSortType=fstNone then Files:=nil
else Files:=TList.Create;
FindResult := FindFirstUTF8(SearchStr, faAnyFile, DirInfo);
while FindResult = 0 do
begin
Application.ProcessMessages;
IsDirectory := (DirInfo.Attr and FaDirectory = FaDirectory);
IsValidDirectory := (DirInfo.Name <> '.') and (DirInfo.Name <> '..');
IsHidden := (DirInfo.Attr and faHidden = faHidden);
{$IFDEF Unix}
if (DirInfo.Name<>'') and (DirInfo.Name[1]='.') then
IsHidden:=true;
{$ENDIF}
// First check if we show hidden files
if IsHidden then AddFile := (otHidden in AObjectTypes)
else AddFile := True;
// If it is a directory, check if it is a valid one
if IsDirectory then
AddFile := AddFile and ((otFolders in AObjectTypes) and IsValidDirectory)
else
AddFile := AddFile and (otNonFolders in AObjectTypes);
// AddFile identifies if the file is valid or not
if AddFile then
for i := 0 to MaskStrings.Count - 1 do
begin
if not Assigned(Files) then begin
// Mark if it is a directory (ObjectData <> nil)
if IsDirectory then ObjectData := AResult
else ObjectData := nil;
AResult.AddObject(DirInfo.Name, ObjectData)
end else
Files.Add ( TFileItem.Create(DirInfo));
SearchStr := IncludeTrailingPathDelimiter(ABaseDir) + MaskStrings.Strings[i];
FindResult := FindFirstUTF8(SearchStr, faAnyFile, DirInfo);
while FindResult = 0 do
begin
Application.ProcessMessages;
IsDirectory := (DirInfo.Attr and FaDirectory = FaDirectory);
IsValidDirectory := (DirInfo.Name <> '.') and (DirInfo.Name <> '..');
IsHidden := (DirInfo.Attr and faHidden = faHidden);
{$IFDEF Unix}
if (DirInfo.Name<>'') and (DirInfo.Name[1]='.') then
IsHidden:=true;
{$ENDIF}
// First check if we show hidden files
if IsHidden then AddFile := (otHidden in AObjectTypes)
else AddFile := True;
// If it is a directory, check if it is a valid one
if IsDirectory then
AddFile := AddFile and ((otFolders in AObjectTypes) and IsValidDirectory)
else
AddFile := AddFile and (otNonFolders in AObjectTypes);
// AddFile identifies if the file is valid or not
if AddFile then
begin
if not Assigned(Files) then begin
// Mark if it is a directory (ObjectData <> nil)
if IsDirectory then ObjectData := AResult
else ObjectData := nil;
AResult.AddObject(DirInfo.Name, ObjectData)
end else
Files.Add ( TFileItem.Create(DirInfo));
end;
FindResult := FindNextUTF8(DirInfo);
end;
FindCloseUTF8(DirInfo);
end;
FindResult := FindNextUTF8(DirInfo);
finally
MaskStrings.Free;
end;
FindCloseUTF8(DirInfo);
if Assigned(Files) then begin
Objectdata:=AResult;