Создание PopUpMenu по названиям папок

[Mag992]

Всем прив!
У мну такое задание...написать прогу (часть проги), которая создает динамически PopUpMenu с элементами из названий папок в директории с прогой, т.е.:
Лежит в одной директории с ехешником 2 папки, соответственно у менюшки будет 2 элемента...допустим, в первой папке есть 3 подпапки, соответственно, у первого элемента менюшки будет 3 подэлемента...и т.д.
Заранее кол-во папок и вложений не известно.

Для создания меню использую такой код:

procedure TMain_Form.PopupMenu1Popup(Sender: TObject);
var
  Menu, MSub: TmenuItem;
  m,sm:string;
begin

with (Sender as TPopupMenu) do
  while Items.Count > 0 do
    begin
      Items.delete(0);
      Items[0].Free;
    end;

nanku(GetCurrentDir, '*.*', ListBox1.Items);

    with (Sender as TPopupMenu) do
      begin
        Menu:=TMenuItem.Create(self);
        Menu.Caption:=;
        Menu.OnClick:=MyClick;
        Items.Insert(0, Menu);
      end;
  end;

Menu:=TMenuItem.Create(self);
Popupmenu1.Items.Insert(1, Menu);

with Menu do
  begin
    Caption:='кряк';
    MSub:= TMenuItem.Create(self);
    MSub.Caption:=sm;
    MSub.OnClick:=MyClick;
  end;

Menu.Insert(0, MSub);
end;

end;

Для поиска папок в директории с прогой:

Procedure nanku(StartDir: String; Mask:string; List:TStrings);
var
  SearchRec: TSearchRec;
begin
  if StartDir[Length(StartDir)] <> '\' then StartDir := StartDir + '\';
  if FindFirst(StartDir + Mask, faAnyFile, SearchRec) = 0 then
    begin
      repeat
        if (SearchRec.Attr and faDirectory) = faDirectory then
          if (SearchRec.Name <> '..') and (SearchRec.Name <> '.')then
            begin
              List.Add(StartDir + SearchRec.Name + '\');
              nanku(StartDir + SearchRec.Name + '\', Mask, List);
            end;
        until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);
    end;
end;

или подскажите как записывать в тот же текстовый файл пути к папкам, отрезая путь до папки в которой ехешник лежит....т.е.: с:\папка1\папка2\прога.ехе будет как папка2\прога.ехе

или вот с:\папка1\папка2\папка3 будет папка2\папка3

[Stilet]

Заранее кол-во папок и вложений не известно.

А меню будут вложенные как и папки или все в одну кучу скиданы?

[Mag992]

Сообщение от Stilet

А меню будут вложенные как и папки или все в одну кучу скиданы?

тоже вложенные, если у папки есть подпапка, то и у меню будет подменю

[Stilet]

Хм... Тогда я бы не заморачивлся с путями.
смотри - поиском проходишь по папке, выбирая все папки в ней (названия), создавая по ним элементы меню.
Каждому элементу назначаешь обработчик, в котором запускаешь опять поиск, но уже по папке, имя которой в кликнутом меню, и точно так же создаешь для него свои подпункты.
а чтоб узнать полный путь для определенного итема просто в цикле пройдись от кликнутого меню до его самого главного предка свойсвом Parent.

Понял идею?

[Mag992]

идею то я понял...не могли бы вы показать как это реализовать? Мне нужно слепить из двух процедур, представленных выше, одну?
И обьясните, как получить имя папки...а то при Menu.Caption:=SearchRec.Name делфя ругается

[Mag992]

ПОлучилась вот такая ересь...как видно из кода создает кол-во менюшек по кол-ву папок в директории....но все менюшки с названием "1", как получить имя папки?

StartDir:=GetCurrentDir;
if StartDir[Length(StartDir)] <> '\' then StartDir := StartDir + '\';
  if FindFirst(StartDir + '*.*', faAnyFile, SearchRec) = 0 then
    begin
      repeat
        Application.ProcessMessages;
        if ((SearchRec.Attr and faDirectory) = faDirectory) and
           ((SearchRec.Name <> '..') and (SearchRec.Name <> '.'))then
            begin
              ListBox1.Items.Add(StartDir + SearchRec.Name + '\');
              with (Sender as TpopupMenu) do
                begin
                    Menu:=TMenuItem.Create(Self);
                    Menu.Caption:='1';
                    Menu.OnClick:=MyClick;
                    Items.Insert(0, Menu);
                end;
              FauJIbl(StartDir + SearchRec.Name + '\', ListBox1.Items);
            end;
        until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);
    end;

Уже понял) Menu.Caption:=SearchRec.Name;

[Stilet]

Смотри:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N11: TMenuItem;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

 Procedure nanku(StartDir: String; Mask:string; menu:TMenuItem);
var
  SearchRec: TSearchRec; m:TMenuItem;
begin
  if StartDir[Length(StartDir)] <> '\' then StartDir := StartDir + '\';
  if FindFirst(StartDir + Mask, faAnyFile, SearchRec) = 0 then
    begin
      repeat
        if (SearchRec.Attr and faDirectory) = faDirectory then
          if (SearchRec.Name <> '..') and (SearchRec.Name <> '.')then
            begin
               m:=TMenuItem.Create(menu);
               m.Caption:=SearchRec.Name ;
               menu.Add(m);
              nanku(StartDir + SearchRec.Name + '\', Mask, m);
            end;
        until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);
    end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  nanku('c:\temp','*',N11);
end;

end.

Уловил смысл?

[Mag992]

да да да)) спс большое! у мну была проблема, как впихнуть создание меню....пробовал как я выше написал, создавал только один уровень))
Ваш код робит)
Наверн думаю, если в процедуре прописать Const Mask= '*.*', ей хуже не станет)
Хотя....можно убрать вообще

Сообщение от Stilet

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

т.е. в MyClick процедуру впихнуть цикл фор итемс=0 ту итемс каунт, в котором проверяем есть ли в конечном подменю (подпапке) файлы и привязываем к шеллехекуте()?

[Stilet]

ей хуже не станет)

Ну если станет сунь ей валидол под язык

[Mag992]

Сообщение от Stilet

Ну если станет сунь ей валидол под язык

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