Меню
Стандартная программа содержит поле MenuBar типа ТМепиВаr. По умолчанию Метод TApplicatlon.InitMenuBar устанавливает это поле в NIL, что означает отказ от меню. Если Вы хотите использовать меню в Вашей программе, необходимо перекрыть этот метод. В следующем примере создается двухуровневое меню, показанное на рис.23. 1.
Рис. 23.1. Двухуровневое меню
Опцию «Подменю...» можно выбрать следующими способами:
Опции «Первый выбор» и «Второй выбор» можно выбрать клавишами F1 и F2 без развертывания подменю. После развертывания подменю можно использовать те же клавиши, а также использовать клавиши с цифрами 1 и 2, отметку мышью или смещение указателя к нужной опции и Enter. Опция «Третий выбор» доступна только после развертывания подменю. Выбор каждой из этих трех опций приводит к появлению на экране окна с сообщением. Кроме того, опция «Третий выбор» попеременно запреща-ет или разрешает действие команд cm1, cm2 и cmQuit.
{$X+}
Uses Objects,App,Menus,Drivers,Views,MsgBox;
type
MyApp = object (TApplication)
Procedure InitMenuBar; Virtual;
Procedure HandleEvent(var Event: TEvent); Virtual;
end;
const
cm1 = 201;
cm2 = 202;
cm3 = 203;
{----------------}
Procedure MyApp. InitMenuBar;
var
R: TRect;
begin
GetExtent (R) ;
R.B.Y := succ(R.A.Y) ;
MenuBar := New ( PMenuBar , Init(R,
NewMenu ( {Главная полоса меню}
NewSubMenu ( {Первый элемент главного меню}
' ~S~ Подменю. ..', hcNoContext,
NewMenu ( {Определить выпадающее подменю}
NewItem( '~1~ Первый выбор ' , ' F1 ' , kbF1, cm1, 0,
NewItem('~2~ Второй выбор' , ' F2 ' , kbF2, cm2, 0,
NewLine( {Определить разделяющую линию}
NewItem('~3~ Третий выбор' , ' ' , 0, cm3, 0,
NIL) ) ) ) ) ,
NewItem( {Второй элемент главного меню}
'-ESO Выход' , '~ESC~' , kbEsc,cmQuit, 0, NIL))))); end {MyApp. InitMenuBar} ;
{------------------}
Procedure MyApp . HandleEvent ;
const
Flag: Boolean = True;
cms = [cm1, cm2, cmQuit] ;
begin
Inherited HandleEvent (Event) ;
case Event . Command of
cm1: MessageBox (#3 'Первый выбор', NIL,0);
cm2 : MessageBox (#3 'Второй выбор', NIL,0);
cm3 :
begin
MessageBox (#3' Третий выбор', NIL,0);
if Flag then
DisableCommands (cms)
else
EnableCommands (cms) ;
Flag := not Flag
end
end
end {MyApp .HandleEvent } ;
{------------------}
var
P: MyApp;
begin
P.Init;
P.Run;
P.Done
end.
