Меню

Стандартная программа содержит поле MenuBar типа ТМепиВаr. По умолчанию Метод TApplicatlon.InitMenuBar устанавливает это поле в NIL, что означает отказ от меню. Если Вы хотите использовать меню в Вашей программе, необходимо перекрыть этот метод. В следующем примере создается двухуровневое меню, показанное на рис.23. 1.

Рис. 23.1. Двухуровневое меню

Опцию «Подменю...» можно выбрать следующими способами:

нажатием клавиш F10 - <смещение указателя> - Enter;

командой Alt-S;

отметкой мышью.

Опции «Первый выбор» и «Второй выбор» можно выбрать клавишами 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.