Как создать в 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]

На какой строке кода вываливается?

Из процедур
Procedure FindFilesInDir(Path, FileMask: String; SearchSubDir:Boolean; var SearchList:TStringList);
удали - var SearchList:TStringList.
Вроде должно работать.

← →
leonidus (2003-05-14 22:45) [6]

Большое спасибо я разобрался

Как создать в run-time PopUp и SumItem`ами? Найти похожие ветки