Mega Code Archive
Pan, zoom and rotate grid, Find files
<![CDATA[
Title: Pan, zoom and rotate grid, Find files
Question: Need some general grid components to draw on? Need to find files in a sophisticated way?
Answer:
Now available in three flavours:
- Basic Grid
- Calendar
- Calendar files
This all is FLICKER FREE!!
All components inherit from the basic grid. Especially the last component uses a filesearch routine. The code for this one is very nice, including include/exclude filter. Exclude filters especially made my life easier. Her is the code for the filesearches (you can find the other components on my website):
unit uSearchFiles;
interface
uses
sysUtils, classes;
type
TSearchFiles = class
public
lastFileFound: string;
lastDirectorySearched: string;
function searchSingleFile(Directory, filemask: string; searchSubDirs: boolean): string; stdcall;
private
FevFileFound: TNotifyEvent;
FevSearchingDirectory: TNotifyEvent;
published
property evFileFound: TNotifyEvent read FevFileFound write FevFileFound;
property evSearchingDirectory: TNotifyEvent read FevSearchingDirectory write FevSearchingDirectory;
procedure searchFilesMasks(PathNamesInc, FileNamesInc, fileNamesExcl: Tstrings; searchSubDirs, oneFileOnly: boolean; var Result: TStringlist; Directories: TStringlist = nil); stdcall;
procedure searchFiles(PathNamesInc, FileNamesInc, fileNamesExcl: string; searchSubDirs, oneFileOnly: boolean; var Result: TStringlist; allDirs: Tstringlist = nil); stdcall;
end;
var
searchFiles: TSearchFiles;
implementation
uses StrUtils, dialogs, Masks;
{ TSearchFiles }
procedure TSearchFiles.searchFilesMasks(PathNamesInc, FileNamesInc, fileNamesExcl: Tstrings; searchSubDirs, oneFileOnly: boolean; var Result: TStringlist; Directories: TStringlist = nil);
var
Rec: TSearchRec;
i, j: integer;
SubDirs, badFiles: TStringlist;
foundFile: string;
begin
badFiles := TStringList.Create;
if PathNamesInc nil then begin
for i := 0 to PathNamesInc.Count - 1 do begin
// Door alle files heen lopen
if FindFirst(IncludeTrailingPathDelimiter(PathNamesInc[i]) + '*', faAnyFile, rec) = 0 then begin
try
repeat
if (rec.Name '.') and (rec.Name '..') and ((Rec.Attr and faDirectory) faDirectory) then begin
if fileNamesExcl nil then begin
for j := 0 to fileNamesExcl.Count - 1 do begin
if MatchesMask(rec.Name, fileNamesExcl[j]) then begin
foundFile := IncludeTrailingPathDelimiter(PathNamesInc[i]) + rec.Name;
badFiles.Add(foundFile);
end;
end;
end;
if FileNamesInc nil then begin
for j := 0 to FileNamesInc.Count - 1 do begin
if MatchesMask(rec.Name, FileNamesInc[j]) then begin
foundFile := IncludeTrailingPathDelimiter(PathNamesInc[i]) + rec.Name;
if (Result.IndexOf(foundFile) = -1) and (badFiles.IndexOf(foundFile) = -1) then begin
Result.Add(foundFile);
if oneFileOnly then break;
end;
end;
end;
end;
end;
until FindNext(rec) 0;
finally
FindClose(rec);
end;
end;
// eerst alle subDirs opzoeken
if searchSubDirs then begin
try
if (oneFileOnly and (Result.Count = 0)) or not oneFileOnly then begin
if FindFirst(IncludeTrailingPathDelimiter(PathNamesInc[i]) + '*.*', faDirectory, Rec) = 0 then begin
repeat
// als dit een directory is, dan subDirs aflopen.
if ((Rec.Attr and faDirectory) = faDirectory) and (Rec.Name[1] '.') then begin
// een event genereren
try
{ if Assigned(FevSearchingDirectory) then begin
lastDirectorySearched := IncludeTrailingPathDelimiter(PathNamesInc[i]) + rec.Name;
evSearchingDirectory(self);
end;}
except
end;
// doorzochte padnamen geven indien gewenst
if (Directories nil) then begin
Directories.Add(IncludeTrailingPathDelimiter(IncludeTrailingPathDelimiter(PathNamesInc[i]) + rec.Name));
end;
SubDirs := TStringList.Create;
SubDirs.Add(IncludeTrailingPathDelimiter(PathNamesInc[i]) + rec.Name);
searchFilesMasks(SubDirs, FileNamesInc, fileNamesExcl, searchSubDirs, oneFileOnly, result, Directories);
subDirs.Free;
if (oneFileOnly and (result.count 0)) then break;
end;
until FindNext(rec) 0
end;
end;
finally
FindClose(Rec);
end;
end;
end;
end;
badFiles.Free;
end;
function TSearchFiles.searchSingleFile(Directory, filemask: string; searchSubDirs: boolean): string;
var
PathNamesInc, FileNamesInc, tempString: Tstringlist;
begin
result := '';
if not DirectoryExists(Directory) then exit;
PathNamesInc := TStringList.Create;
FileNamesInc := TStringList.Create;
tempString := TStringList.Create;
PathNamesInc.Add(Directory);
FileNamesInc.Add(filemask);
searchFilesMasks(PathNamesInc, FileNamesInc, nil, searchSubDirs, true, tempString);
if tempString.Count 0 then begin
result := tempString[0];
end;
PathNamesInc.Free;
FileNamesInc.Free;
tempString.Free;
end;
procedure TSearchFiles.searchFiles(PathNamesInc, FileNamesInc, fileNamesExcl: string; searchSubDirs, oneFileOnly: boolean; var Result: TStringlist; allDirs: Tstringlist);
var
pathNames, FilesInc, filesExcl: Tstringlist;
begin
pathNames := TStringList.Create;
FilesInc := TStringList.Create;
filesExcl := TStringList.Create;
PathNames.add(PathNamesInc);
FilesInc.Add(FileNamesInc);
filesExcl.Add(fileNamesExcl);
searchFilesMasks(pathNames, FilesInc, filesExcl, searchSubDirs, oneFileOnly, result, allDirs);
pathNames.free;
FilesInc.Free;
filesExcl.Free;
end;
end.
]]>