|
|
|
|
Delphi 1
Динамическое добавление пунктов меню II
Вот пример программы, создающей структуру меню большой вложенности двумя различными способами. Она даст вам пищу для размышлений. Форма содержит компонент TMainMenu1 и, первоначально, одно подменю с именем SubMenu1.
|
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.
|
- Neil J. Rubenking [000769]
|
|
|
|
|