Вопрос об отображении иерархии в TPopupMenu

← →
leonidus (2003-10-10 17:11) [0]

Подскажите пожалуйста как должен выглядеть алгоритм рекурсивного заполнения компонента PopupMenu для отображения данной директории на диске. Мне надо представить папку "Избранное" так же как она отображается в MSIE. Помогите пожалуйста уже вторые сутки бьюсь!!!

← →
Романов Р.В. © (2003-10-10 17:17) [1]

Алгоритм рекурсивного обхода папок в FAQ

← →
From_X (2003-10-10 17:23) [2]

короче просто ищещь в заданной директории файлы и поддиректории.
если что то найдены то заполняешь TPopupMenu.
далее для всех поддиректорий делаешь все аналогично- рекурсивно

← →
leonidus (2003-10-10 20:12) [3]

А может у кого-нибудь примерчик есть?

← →
Palladin © (2003-10-10 20:39) [4]

покажи что у тебя есть

← →
leonidus (2003-10-11 12:28) [5]

Я написал процедурку которая сканирует данную директорию и в массив собирает все найденные файлы с расширением url (это и есть закладки) и получается массив такого вида:
links\1.url
links\2.url
links\3.url
work\abc\1.url
work\abc\2.url
work\1.url

вот теперь значениями из этотого массива надо заполнить TPopupMenu в соответствии со структурой.

← →
pasha_golub © (2003-10-11 12:30) [6]

2leonidus
Код покажи, а не результат, хотя судя по результату ты рекурсию наверное используешь

← →
leonidus (2003-10-11 12:37) [7]

Вот код функции которую я использую для поиска всех файлов в папке "Избранное" все найденное записывется в str:TStringList а уж потом я работаю с ним как с массивом выбирая от туда ссылки и все что мне надо. Тут конечно используется рекурсия, но как ее использовать для заполнения TPopupMenu я не догоняю.

function GetIEFavourites_filename(Dir:string):boolean;
var
SearchRec : TSearchRec;
Separator : string;
begin

if Copy(Dir,Length(Dir),1)="\" then
Separator := ""
else
Separator := "\";

if FindFirst(Dir+Separator+"*.*",faAnyFile,SearchRec) = 0 then
{что-то найдено}
begin
if FileExists(Dir+Separator+SearchRec.Name) then
{найден файл}
begin
str.Add(Dir+Separator+SearchRec.Name);
end
{найден каталог}
else
if DirectoryExists(Dir+Separator+SearchRec.Name) then
begin
if (SearchRec.Name<>".") and (SearchRec.Name<>"..") then
begin
GetIEFavourites_filename(Dir+Separator+SearchRec.Name);
end;
end;

while FindNext(SearchRec) = 0 do
begin
if FileExists(Dir+Separator+SearchRec.Name) then
begin
str.Add(Dir+Separator+SearchRec.Name);
end
else
if DirectoryExists(Dir+Separator+SearchRec.Name) then
begin
if (SearchRec.Name<>".") and (SearchRec.Name<>"..") then
begin
GetIEFavourites_filename(Dir+Separator+SearchRec.Name);
end;
end;
end;
end;
FindClose(SearchRec);
end;

← →
pasha_golub © (2003-10-11 14:07) [8]

2leonidus
Код прямо скажем запущенный.
pm:TPopupMenu

procedure ItemsAdd(RootItem: TMenuItem; Dir: string); var SR:TSearchRec; Item:TMenuItem; begin if FindFirst(Dir+"\*", faAnyFile or faDirectory,SR) = 0 then Repeat if ((SR.Attr and faDirectory) = faDirectory) and (SR.Name<>".") and (SR.Name<>"..") then begin Item := TMenuItem.Create(Form1); Item.Caption := SR.Name; RootItem.Add(Item); ItemsAdd(item,Dir+"\"+SR.Name); end else begin Item := TMenuItem.Create(Form1); Item.Caption := SR.Name; RootItem.Add(Item); end; Until FindNext(SR) <> 0; end; procedure TForm1.Button1Click(Sender: TObject); begin pm.Items.Add(TMEnuItem.Create(Self)); ItemsAdd(pm.Items[0],"d:\test"); end;

← →
pasha_golub © (2003-10-11 14:11) [9]

Эту процедуру для наглядности перепишем
procedure TForm1.Button1Click(Sender: TObject); begin pm.Items.Add(TMEnuItem.Create(Self)); ItemsAdd(pm.Items[0],"d:\test"); end; ==> procedure TForm1.Button1Click(Sender: TObject); var Item:TMenuItem; begin Item := TMEnuItem.Create(Self); Item.Caption := "d:\test"; pm.Items.Add(Item); ItemsAdd(Items,Item.Cpation); end;

← →
pasha_golub © (2003-10-11 14:42) [10]

Ошибка
ItemsAdd(Items,Item.Cpation);
Надо
ItemsAdd(Item,Item.Cpation);

← →
leonidus (2003-10-11 21:28) [11]

Че-то не работает это дело выдается ошибка "Access violation..."

← →
Palladin © (2003-10-11 22:22) [12]

procedure ItemsAdd(RootItem: TMenuItem; Dir: string); var SR:TSearchRec; Item:TMenuItem; begin if FindFirst(Dir+"\*.*", faAnyFile,SR) = 0 then Repeat if (sr.name<>".") and (sr.name<>"..") then begin Item := TMenuItem.Create(Form1); Item.Caption := SR.Name; RootItem.Add(Item); if ((SR.Attr and faDirectory) = faDirectory) then ItemsAdd(item,Dir+"\"+SR.Name); end; Until FindNext(SR) <> 0; FindClose(sr); end;

← →
Palladin © (2003-10-11 22:26) [13]

ну вот, закралась маленькая ошибка, кто найдет тому приз :)

← →
leonidus (2003-10-12 15:21) [14]

>Palladin но твой аглоритм ведь тоже не работает, все таже ошибка вылазеет!

← →
Palladin © (2003-10-12 15:25) [15]

> leonidus (12.10.03 15:21) [14]

парень, ты TPopupMenu создал?
моя процедура это переделка процедуры pasha_golubя, вернее устранение его ошибки с директориями "." и "..", ну и немного упрощенная на предмет нагромождения конструкций...

Твоя ошибка, это твоя ошибка, и никакого отношения эта твоя ошибка к данной процедуре не имеет.

← →
leonidus (2003-10-12 16:52) [16]

>Palladin - прости пожалуйста, я действительно не создал TPopupMenu. Все работает, единственное при вызове процедуры

Item := TMEnuItem.Create(Self);
Item.Caption := path_favor;
pm.Items.Add(Item);
ItemsAdd(Items,Item.Cpation);

Первый пункт создается path_favor а потом уже вся структура данной папки, а как сразу всю структуру отобразить без этого начального итема?

Item := TMEnuItem.Create(Self);
Item.Caption := path_favor;
pm.Items.Add(Item);
ItemsAdd(Item,Item.Cpation);

← →
leonidus (2003-10-12 17:29) [18]

>Palladin не понял...

Вызывай не
ItemsAdd(Items,Item.Caption);
а
ItemsAdd(Item,Item.Caption);

тоесть начинай сканировать и добаволять в только что созданный пункт и убедись что путь выставлен верно...

← →
leonidus (2003-10-12 18:21) [20]

>Palladin - я не от туда скопировал код, вот как я вызываю процедуру сканирования:

pm:=tPopupMenu.Create(self);
Item := TMenuItem.Create(Self);
Item.Caption := path_favor;
pm.Items.Add(Item);
ItemsAdd(Item,Item.Caption);

Но самым первым итемом естественно получается path_favor - т.е. сам путь к папке "Избранное", а мне он не нужен, надо просто содержимое самой папки. Как это сделать?

> leonidus (12.10.03 18:21) [20]

чего удивлятся, ведь ты его сам добавил
pm.Items.Add(Item);
не создавай тогда...

pm:=tPopupMenu.Create(self); ItemsAdd(pm,path_favor);

← →
leonidus (2003-10-12 21:10) [22]

Всем большое спасибо - заработало!

2Palladin
Да точно, много лишнего. Я этот код из другого проекта брал, да вообще-то многовато лишнего :-)

Вопрос об отображении иерархии в TPopupMenu Найти похожие ветки