Советы по Delphi


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


Вот пример программы, создающей структуру меню большой вложенности двумя различными способами. Она даст вам пищу для размышлений. Форма содержит компонент TMainMenu1 и, первоначально, одно подменю с именем SubMenu1.

unit Istopmnu;
interface
uses
SysUtils, 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]



Содержание раздела