|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Динамическое заполнение MainMenu
Доброе время суток, уважаемы форумчане. Возникла необходимость заполнить главное меню найденными директориями с их субдиректориями. Директорий будет немного. Непонятным чудом пришёл к такому коду(сильно не пинайте)
Код:
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; |