Честно говоря, я так и не понял к чему вы хотите добавлять новые пункты меню - к верхнему уровню или в качестве подменю. На всякий случай я публикую оба метода. Выбирайте любой.
Новый элемент верхнего уровня:
procedure tform1.addmainitem(s:string); var newitem : Tmenuitem;begin newitem:=tmenuitem.create(Mainmenu1);newitem.caption:=s;{если вы хотите определить событие onclicknewitem.onclick:=Dynamenuclick; }{добавляем это к верхнему уровню меню}mainmenu1.items.insert(mainmenu1.items.count,newitem);removemenu1.enabled:=true;addmenuitem1.enabled:=true;end; |
Создание подменю:
|
procedure tform1.addsubitem(s:string; to : integer); var newitem, toitem : Tmenuitem;begin {to = верхний уровень меню для нового пункта}toitem:=mainmenu1.items[to];newitem:=tmenuitem.create(toitem);newitem.caption:=s;{если вы хотите определить событие onclicknewitem.onclick:=Dynamenuclick; }toitem.onclick:=nil;toitem.insert(toitem.count,newitem);removemenuitem1.enabled:=true;end; |
Решение 2
Вы можете использовать готовые функции, определенные в модуле Menus. Определения в Delphi 2:
function NewMenu(Owner: TComponent; const AName: string; Items: array of TMenuItem): TMainMenu; function NewPopupMenu(Owner: TComponent; const AName: string; Alignment: TPopupAlignment; AutoPopup: Boolean; Items: array ofTMenuitem): TPopupMenu;function NewSubMenu(const ACaption: string; hCtx: Word; const AName: string; Items: array of TMenuItem): TMenuItem;function NewItem(const ACaption: string; AShortCut: TShortCut; AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: Word;const AName: string): TMenuItem;function NewLine: TMenuItem; |
Это превращает вышепоставленную задачу в сущий пустяк. [000176]
unit Istopmnu; interface usesSysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,Controls, Forms, Dialogs, StdCtrls, Menus; typeTForm1 = class(TForm)MainMenu1: TMainMenu;SubMenu1: TMenuItem;procedure AClick(Sender: TObject);procedure FormCreate(Sender: TObject);private{ Private declarations }public{ Public declarations }end; varForm1: TForm1; implementation {$R *.DFM} procedure TForm1.AClick(Sender: TObject);VARTM : TMenuItem;Lev : Word;beginMessageBeep(0);TM := Sender AS TMenuItem;IF TM.Count > 0 THENCaption := 'подменю'ELSE Caption := 'элемет меню';Caption := Caption + ' с именем "' + TM.Name + '"';Lev := 0;WHILE (TM.Parent <> NIL) AND (TM.Parent IS TMenuItem) DOBEGINTM := TM.Parent;Inc(Lev);END;CASE Lev OF1 : Caption := 'Верхний уровень ' + Caption;2 : Caption := '2-й уровень ' + Caption;3 : Caption := '3-й уровень ' + Caption;ELSE Caption := Format('%d-й уровень %s', [Lev, Caption]);END;end; procedure TForm1.FormCreate(Sender: TObject);VARTM : TMenuItem;N : Integer;beginTM := SubMenu1;TM.Add(NewItem('&Элемент',0,False,True,AClick,0,'MenuItem2'));FOR N := 2 TO 5 DOBEGINTM.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 DOBEGINTM.OnClick := AClick;IF TM.Count < 2 THEN Break;TM := TM.Items[1];END;end; end. |
- Neil J. Rubenking [000769]