Листинг программы:
Uses App, Objects, Menus, Drivers, Views;
const
{Команды для обработчиков событий:}
cmWork = 203; {Обработать данные}
cmDOS = 204; {Временно выйти в ДОС}
WinComl: TCommandSet = [cmSave,cmWork]; {Множество временно недоступных команд}
type
TNotebook = object (TApplication) {Создаем объект-потомок от TApplication}
Procedure InitStatusLine; Virtual; {Перекрываем старый метод InitStatusLine новым}
Procedure InitMenuBar; Virtual; {Перекрываем стандартный метод InitMenuBar}
end;
{---------}
Procedure TNotebook. InitStatusLine;
{Формирует строку статуса}
var
R: TRect; {Границы строки статуса}
begin
GetExtent (R,); {Получаем в R координаты всего экрана}
R.A.Y := pred(R.B.Y) ; StatusLine := New(PStatusLine,
Init(R, {Создаем строку статуса}
NewStatusDef (0, $FFFF, {Устанавливаем максимальный диапазон контекстной справочной службы}
NewStatusKey('~Alt-X~ Выход', kbAltX, cmQuit,
NewStatusKey('~F2~ Сохранить', kbF2, cmSave,
NewStatusKey('~F3~ Открыть', kbF3,cmOpen,
NewStatusKey('~F4~ Работа', kbF4,cmWork,
NewStatusKey('~F10~ Меню', kbF10,cmMenu, Nil))))),{Нет других клавиш}
Nil){Нет других определений}
));
DisableCommands(WinComl) {Запрещаем недоступные команды}
end; {TNotebook.InitStatusLine}
{---------}
Procedure TNotebook.InitMenuBar;
{Создание верхнего меню}
var
R: TRect;
begin
GetExtent (R) ;
R.B.Y := succ(R.A.Y) ; {R - координаты, строки меню}
MenuBar := New ( PMenuBar , Init(R, NewMenu ( {Создаем меню}
{Первый элемент нового меню представляет собой подменю (меню второго уровня) . Создаем его}
NewSubMenu( '~F~/ Файл', hcNoContext,
{Описываем элемент главного меню}
NewMenu ( {Создаем подменю}
NewItem( {Первый элемент}
'~1~/ Открыть ', 'F3' , kbF3,cmOpen, hcNoContext,
NewItem( {Второй элемент}
'~2~/ Сохранить ', 'F2', kbF2, cmSave, hcNoContext,
NewItem( {Третий элемент}
'~3~/ Сменить диск' , ' ' , 0, cmChangeDir,hcNoContext,
NewLine ( {Строка-разделитель}
NewItem('~4~/ Вызов ДОС' , ' ' , 0, cmDOSShell,
hcNoContext,
NewItem('~5~/ Конец работы' , 'Alt-X' ,
kbAltX, cmQuit, hcNoContext,
NIL) ) ) ) ) ) ), {Нет других элементов подменю}
{Создаем второй элемент главного меню}
NewItem( '~W~/ Работа', ' ', kbF4, cmWork, hcNoContext,
NIL) {Нет других элементов главного меню} ))))
end; {TNotebook. InitMenuBar}
var
Notebook: TNotebook;{Изменен тип переменной!}
begin
Notebook. Init;
Notebook. Run;
Notebook. Done
end .