Меню

Стандартная программа содержит поле 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.