Динамическое создание "суб-меню" из файлов в заданном каталоге

[Abhorrer]

Поискал по форуму... не нашёл то что нужно... и в гугле искал... тоже... Похожее было, но не то... Может быть и есть, но я не нашёл...

Собственно проблема) Во многих программах есть меню "Вид", в нём есть среди остальных пунктов пункт "Языки" - при наведении на него открывается суб-меню в котором содержытся список языков (всех файлов с расширением *.lng в каталоге "программа\languages")

Подскажите пожалуйста как это сделать?)

Сразу прошу прощенья, если это уже где-то обсуждалось

[KORN]

http://programmersforum.ru/showthrea...2+%EC%E5%ED%FE

плохо искал... вот тут есть про создание меню...

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

[Abhorrer]

Спасибо, я всё просмотрел там... Кое как, с помощью одного человека вот что вышло:

type
......................
  TForm1 = class(TForm)
  mm_Skins: TMenuItem;
  SkinManager: TsSkinManager;
  procedure asdfg(Sender: TObject);
......................
var
  Form1: TForm1;
  SearchRec:TSearchRec;
......................
procedure TMoviesKeeper.asdfg(Sender: TObject);
begin
  movieskeeper.SkinManager.SkinName:=SearchRec.Name;
end;
......................
procedure TForm1.FormCreate(Sender: TObject);
  var i:TMenuItem;
begin
   skinmanager.SkinDirectory:='Skins/';

   If FindFirst('Skins/*.asz', faAnyFile, SearchRec)=0 then
      repeat
        i:=TMenuItem.Create(MainMenu);
        i.Caption:=Copy(SearchRec.name, 1, Length(SearchRec.name) - Length(ExtractFileExt(SearchRec.name)));
        i.OnClick:=asdfg;
        mm_skins.Add(i);
      until FindNext(SearchRec) <> 0;
   FindClose(SearchRec);
end;

Проблема в процедуре, которая срабатывает при OnClick.... В общем эта процедура ничего не делает xD
Как доделать её, чтобы при клике всё таки скин менялся?)

[Kotofff]

Вот тут :

procedure TMoviesKeeper.asdfg(Sender: TObject);
begin
  movieskeeper.SkinManager.SkinName:=SearchRec.Name;
end;

... немного по-другому : procedure TForm1.asdfg(Sender: TObject);

[Abhorrer]

Да) Просто у меня форма так называется... переделывал код под Form1... а про этот кусок видимо забыл)

[Abhorrer]

В общем мне помогли и вышло вот так:

type
  TMainForm = class(TForm)
    MainMenu: TMainMenu;
    mm_View: TMenuItem;
    SkinManager: TsSkinManager;
    SkinProvider: TsSkinProvider;
    procedure FormCreate(Sender: TObject);
    procedure MyMenuClick(Sender: TObject);

var
  MainForm: TMainForm;

implementation

{$R *.dfm}


procedure TMainForm.MyMenuClick(Sender: TObject);
begin
  SkinManager.SkinName:=(sender as tmenuitem).Caption;
end;
......................
procedure TMainForm.FormCreate(Sender: TObject);
var
  newItem: TMenuItem;
  tmp: string;
  SearchRec: TSearchRec;
begin
  mm_View.AutoHotkeys:=maManual;
  if FindFirst('Skins/*.asz', faAnyFile, SearchRec) = 0 then
     repeat
       newItem:=TMenuItem.Create(mm_View);
       tmp:=extractfilename(SearchRec.name);
       newItem.Caption:=copy(tmp, 1, length(tmp) - length(extractfileext(tmp)));
       newItem.OnClick:=MyMenuClick;
       mm_View.Items[0].Add(newItem)
     until FindNext(SearchRec) <> 0;
   FindClose(SearchRec)
end;

Так всё работает) Тему можно закрыть