Форум: "Основная";
Текущий архив: 2003.05.26;
Скачать: [xml.tar.bz2];
Вниз
Как создать в run-time PopUp и SumItem`ами? Найти похожие ветки
← →
leonidus (2003-05-13 00:38) [0]Мне надо создать в run-time PopUp такой что бы от отображал структуру папки на винчестере начиная из корня и заканчмвая файлами которые можно будет запустить. Всвязи с чем возник вопрос как создать SumItem`ы и обработать клик по ним?
← →
Zergling (2003-05-13 09:32) [1]var SearchList - уже не нужен
function AddSlashDir(Dir: String): String;
begin
if Dir[Length(Dir)]<> "\" then
Result := Dir+"\"
else
Result := Dir;
end;
Procedure FindFilesInDir(Path, FileMask: String; SearchSubDir:Boolean; var SearchList:TStringList);
{ Ищет файл по маске в каталоге и его подкаталогах}
var
FSearchRec, DSearchRec: TSearchRec;
FindResult: integer;
TmpMenuItem, TmpSubMenuItem: TMenuItem;
function IsDirNotation(ADirName: String): Boolean;
begin
Result := (ADirName = ".") or (ADirName = "..");
end;
begin
Path := AddSlashDir(Path); // Проверка каталога
{ Находится первое вхождение заданного файла }
FindResult := FindFirst(Path+FileMask,faAnyFile+faHidden+
faSysFile+faReadOnly,FSearchRec);
try
{ Поиск файлов в текущем каталоге и если файл найден, то добавляем в список}
while FindResult = 0 do
begin
if Form1.PopupMenu1.Items.Count < 1 then
begin
TmpMenuItem := TMenuItem.Create(Form1);
TmpMenuItem.Caption := Path+FSearchRec.Name;
Form1.PopupMenu1.Items.Add(TmpMenuItem);
end else
begin
TmpSubMenuItem := TMenuItem.Create(Form1);
TmpSubMenuItem.Caption := Path+FSearchRec.Name;
if ExtractFilePath(TmpMenuItem.Caption) <> ExtractFilePath(TmpSubMenuItem.Caption) then
begin
TmpMenuItem.Add(TmpSubMenuItem);
TmpMenuItem := TmpSubMenuItem;
end;
FindResult := FindNext(FSearchRec);
end;
end;
// Поиск файлов в подкаталогах
if SearchSubDir then
Begin
{ А теперь просматриваются подкаталоги текущего каталога }
FindResult := FindFirst(Path+"*.*", faDirectory, DSearchRec);
{ Поиск файлов пока не просмотрены все каталоги}
while FindResult = 0 do
begin
if ((DSearchRec.Attr and faDirectory) = faDirectory) and
not IsDirNotation(DSearchRec.Name) then
// Рекурсия (проседура вызывает саму себя для поиска файлов в каталоге)
FindFilesInDir(Path+DSearchRec.Name,FileMask,SearchSubDir,SearchList);
FindResult := FindNext(DSearchRec);
end;
End;
finally
FindClose(FSearchRec);
end;
end;
← →
Zergling (2003-05-13 09:44) [2]Чуть поправить
if ExtractFilePath(TmpMenuItem.Caption) <> ExtractFilePath(TmpSubMenuItem.Caption) then
begin
TmpMenuItem.Add(TmpSubMenuItem);
TmpMenuItem := TmpSubMenuItem;
end else TmpMenuItem.Add(TmpSubMenuItem);
← →
leonidus (2003-05-13 15:16) [3]>Zergling - большое спасибо за такой расширенный ответ, но почему-то после запуска программы и вызова процедуры FindFilesInDir прога намертво виснет, с чем это может быть связано? Я так понял, что код взят прямо из Вашего проекта и по идее должен быть отлажен, подскажите пожалуйста.
← →
Zergling (2003-05-14 07:47) [4]На какой строке кода вываливается?
← →
Zergling (2003-05-14 07:59) [5]Из процедур
Procedure FindFilesInDir(Path, FileMask: String; SearchSubDir:Boolean; var SearchList:TStringList);
удали - var SearchList:TStringList.
Вроде должно работать.
← →
leonidus (2003-05-14 22:45) [6]Большое спасибо я разобрался
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2003.05.26;
Скачать: [xml.tar.bz2];
Память: 0.46 MB
Время: 0.007 c