Меню

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