Форум по программированию Delphi Sources

 



Вернуться   Форум по программированию Delphi Sources > Все о Delphi > Компоненты и классы
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 23.08.2017, 18:22
Romix Romix вне форума
Начинающий
 
Регистрация: 10.02.2008
Сообщения: 132
Версия Delphi: XE2
Репутация: 41
Восклицание Динамическое заполнение 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  
Старый 23.08.2017, 20:05
Romix Romix вне форума
Начинающий
 
Регистрация: 10.02.2008
Сообщения: 132
Версия Delphi: XE2
Репутация: 41
По умолчанию

После некоторых изысканий удалось получить следующее:
Код:
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  
Старый 23.08.2017, 21:25
Аватар для lmikle
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 6,928
Репутация: 49086
По умолчанию

Ну, если нигде не накосячил, то как то так:
Код:
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  
Старый 23.08.2017, 22:51
Romix Romix вне форума
Начинающий
 
Регистрация: 10.02.2008
Сообщения: 132
Версия Delphi: XE2
Репутация: 41
По умолчанию

Всем большое спасибо! Вот так всё работает:
Код:
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;
Ответить с цитированием
Ответ



Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 09:09.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources", 2004-2017

ВКонтакте   Facebook   Twitter