![]() |
|
|
|||||||
| Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
|
|||
|
|||
|
Доброе время суток, уважаемы форумчане. Возникла необходимость заполнить главное меню найденными директориями с их субдиректориями. Директорий будет немного. Непонятным чудом пришёл к такому коду(сильно не пинайте)
Код:
procedure SearchDirectory(MainMenu: TMainMenu; I: Int32; Directory: String);
var
MenuItem: TMenuItem;
SearchRec: TSearchRec;
begin
if FindFirst(Directory + '*.*', faDirectory, SearchRec) = 0 then
Repeat
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') and
((SearchRec.Attr and faDirectory) = faDirectory) then
begin
MenuItem:=TMenuItem.Create(MainMenu);
MenuItem.Caption:=SearchRec.Name;
MainMenu.Items[i].Add(MenuItem);
SearchDirectory(MainMenu, I + 1, Directory + SearchRec.Name + '\');
end;
Until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;Код:
SearchDirectory(MainMenu, 0, ''); Наставьте неуча на путь истинный. Как правильно сделать рекурсию, что бы подпункты MainMenu тоже заполнялись? |
|
#2
|
|||
|
|||
|
После некоторых изысканий удалось получить следующее:
Код:
procedure SearchDirectory(MainMenu: TMainMenu; MenuItem: TMenuItem; Level: Int32;
Directory: String);
var
SubMenuItem: TMenuItem;
SearchRec: TSearchRec;
begin
if FindFirst(Directory + '*.*', faDirectory, SearchRec) = 0 then
Repeat
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') and
((SearchRec.Attr and faDirectory) = faDirectory) then
begin
if Level = 0 then
begin
MenuItem := TMenuItem.Create(MainMenu);
MenuItem.Caption := SearchRec.Name;
MainMenu.Items[0].Add(MenuItem);
SearchDirectory(MainMenu, MenuItem, Level + 1,
Directory + SearchRec.Name + '\')
end
else
begin
SubMenuItem := TMenuItem.Create(MainMenu);
SubMenuItem.Caption := SearchRec.Name;
MenuItem.Insert(0, SubMenuItem);
SearchDirectory(MainMenu, SubMenuItem, Level + 1,
Directory + SearchRec.Name + '\')
end;
end;
Until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;Может можно это как-то оптимизировать? |
|
#3
|
|||
|
|||
|
Ну, если нигде не накосячил, то как то так:
Код:
procedure SearchDirectory(Menu: TMainMenu; MenuItem: TMenuItem; Directory: String);
var
NewItem: TMenuItem;
SearchRec: TSearchRec;
begin
if FindFirst(IncludeTrailingPathDelimiter(Directory) + '*.*', faDirectory, SearchRec) = 0 then
Repeat
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') and
((SearchRec.Attr and faDirectory) <> 0) then
begin
NewItem := TMenuItem.Create(Menu);
NewItem.Caption := SearchRec.Name;
If MenuItem = Nil
Then Menu.Items.Add(NewItem)
Else MenuItem.Items.Add(NewItem);
SearchDirectory(MainMenu, NewItem, Directory + SearchRec.Name)
end;
Until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
...
SearchDirectory(Form1.MainMenu1, Nil, 'c:/work');
... |
| Этот пользователь сказал Спасибо lmikle за это полезное сообщение: | ||
Romix (23.08.2017)
| ||
|
#4
|
|||
|
|||
|
Всем большое спасибо! Вот так всё работает:
Код:
procedure Fill_MainMenu(MainMenu: TMainMenu; MenuItem: TMenuItem;
Directory: String);
var
SubMenuItem: TMenuItem;
SearchRec: TSearchRec;
begin
if FindFirst(Directory + '\' + '*.*', faDirectory, SearchRec) = 0 then
Repeat
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') and
((SearchRec.Attr and faDirectory) = faDirectory) then
begin
SubMenuItem := TMenuItem.Create(nil);
SubMenuItem.Caption := SearchRec.Name;
if MenuItem = nil Then
MainMenu.Items[0].Add(SubMenuItem)
else
MenuItem.Insert(0, SubMenuItem);
Fill_MainMenu(MainMenu, SubMenuItem,
Directory + SearchRec.Name + '\');
end;
Until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end; |