Динамическое добавление пунктов меню 2

unit Istopmnu;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, Menus;

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

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.AClick(Sender: TObject);
var
  TM: TMenuItem;
  Lev: Word;
begin
  MessageBeep(0);
  TM := Sender as TMenuItem;
  if TM.Count > 0 then
    Caption := 'подменю'
  else
    Caption := 'элемет меню';
  Caption := Caption + ' с именем "' + TM.Name + '"';
  Lev := 0;
  while (TM.Parent <> nil) and (TM.Parent is TMenuItem) do
  begin
    TM := TM.Parent;
    Inc(Lev);
  end;
  case Lev of
    1: Caption := 'Верхний уровень ' + Caption;
    2: Caption := '2-й уровень ' + Caption;
    3: Caption := '3-й уровень ' + Caption;
  else
    Caption := Format('%d-й уровень %s', [Lev, Caption]);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  TM: TMenuItem;
  N: Integer;
begin
  TM := SubMenu1;
  TM.Add(NewItem('&Элемент', 0, False, True, AClick, 0, 'MenuItem2'));
  for N := 2 to 5 do
  begin
    TM.Add(TMenuItem.Create(nil));
    TM := TM.Items[TM.Count - 1];
    TM.Caption := '&Меню';
    TM.Name := 'SubMenu' + IntToStr(N);
    TM.OnClick := AClick;
    TM.Add(NewItem('&Элемент', 0, False, True, AClick, 0,
      'MenuItem' + IntToStr(N + 1)));
  end;
  MainMenu1.Items.Add(NewSubMenu('Меню&2', 0, 'SM1',
    [NewItem('&Элемент', 0, False, True, AClick, 0, 'MI2'),
    NewSubMenu('&Меню', 0, 'SM2',
      [NewItem('&Элемент', 0, False, True, AClick, 0, 'MI3'),
      NewSubMenu('&Меню', 0, 'SM3',
        [NewItem('&Элемент', 0, False, True, AClick, 0, 'MI4'),
        NewSubMenu('&Меню', 0, 'SM4',
          [NewItem('&Элемент', 0, False, True, AClick, 0, 'MI5'),
          NewSubMenu('&Меню', 0, 'SM5',
            [NewItem('&Элемент', 0, False, True, AClick, 0, 'MI6')
            ])
          ])
        ])
      ])
    ]));
  TM := MainMenu1.Items[1];
  while TRUE do
  begin
    TM.OnClick := AClick;
    if TM.Count < 2 then
      Break;
    TM := TM.Items[1];
  end;
end;

end.