procedure TForm1.PopupMenu2Popup(Sender: TObject);
var
mi, msub: TmenuItem;
begin
with (Sender as TPopupMenu) do
begin
// Удаляем все пункты меню
// while Items.Count > 0 do Items.delete(0);
// Предыдущий код имел утечку памяти. Коррекция от Andrew Stewart (astewart@Strobes.co.nz)
while Items.Count > 0 do
Items[0].Free;
// Создаем обычный пункт "Первый"
mi := TMenuItem.Create(self);
with mi do
begin
Caption := 'Первый';
OnClick := MyClick;
end;
Items.Insert(0, mi);
// Создаем подменю "Подменю" c двумя пунктами "Подменю1" и
// "Подменю2"
mi := TMenuItem.Create(self);
with mi do
begin
Caption := 'Подменю';
msub := TMenuItem.Create(self);
with msub do
begin
Caption := 'Подменю1';
OnClick := MyClick;
end;
Insert(0, msub);
msub := TMenuItem.Create(self);
with msub do
begin
Caption := 'Подменю2';
OnClick := MyClick;
end;
Insert(1, msub);
end;
Items.Insert(1, mi);
end;
end;
procedure TForm1.MyClick(Sender: TObject);
begin
beep;
end;
|