uses crt; { Глобальные данные: }
const maxmenu=2; {количество меню}
maxpoints=3; {макс. количество пунктов}
var x1,x2,y: array [1..maxmenu] of integer;
{x1,x2- начало и конец каждого меню, y- строка начала каждого меню}
kolpoints, points: array [1..maxmenu] of integer;{Кол-во пунктов и текущие пункты }
text: array [1..maxmenu,1..maxpoints] of string[12]; { Названия пунктов }
txtcolor, textback, cursorback:integer; { Цвета текста, фона, курсора}
mainhelp:string[80]; { Строка помощи }

procedure DrawMain (s:string); {Очищает экран, рисует строку главного меню s }
begin Window (1,1,80,25);
textcolor (txtcolor);
textbackground (textback);
clrscr; gotoxy (1,1); write (s);
end;

procedure DrawHelp (s:string); { Выводит подсказку s }
var i:integer; begin
textcolor (txtcolor);
textbackground (textback); gotoxy (1,25);
for i:=1 to 79 do write (' ');
gotoxy (1,25); write (s);
end;

procedure doubleFrame (x1,y1,x2,y2:integer; Header: string);
{ Процедура рисует двойной рамкой окно }
var i,j: integer;
begin gotoxy (x1,y1);
write ('╔');
for i:=x1+1 to x2-1 do write('═');
write ('╗');
for i:=y1+1 to y2-1 do begin
gotoxy (x1,i); write('║');
for j:=x1+1 to x2-1 do write (' ');
write('║');
end;
gotoxy (x1,y2); write('╚');
for i:=x1+1 to x2-1 do write('═');
write('╝');
gotoxy (x1+(x2-x1+1-Length(Header))
div 2,y1);
write (Header); {Выводим заголовок}
gotoxy (x1+1,y1+1);
end;

procedure clearFrame (x1,y1,x2,y2:integer);
var i,j:integer;
begin textbackground (textback);
for i:=y1 to y2 do begin
gotoxy (x1,i);
for j:=x1 to x2 do write (' ');
end;
end;

procedure cursor (Menu,Point: integer; Action: boolean);
{ Подсвечивает (если Action=true) или гасит п. Point меню Menu}
begin textcolor (Txtcolor);
if Action=true then
textbackground (cursorBack)
else textbackground (textBack);
gotoxy (x1[Menu]+1,y[Menu]+Point);
write (text[Menu][Point]);
end;

procedure DrawMenu (Menu:integer; Action: boolean);
{Рисует меню с номером Menu, если Action=true, иначе стирает }
var i:integer;
begin
if Action=true then textcolor (Txtcolor)
else textcolor (textBack);
textbackground (textBack);
doubleFrame (x1[Menu], y[Menu], x2[Menu], y[Menu]+1+KolPoints[Menu],'');
for i:=1 to KolPoints[Menu] do begin
gotoxy (x1[Menu]+1, y[Menu]+i);
writeln (text[Menu][i]);
end;
end;

{Часть, определяемая пользователем}

procedure Init; { Установка глобальных данных и начальная отрисовка }
begin
txtcolor:=yELLOW; textback:=BLUE;
cursorback:=LIGHTcyAN;
kolpoints[1]:=2; kolpoints[2]:=1;
{пунктов в каждом меню}
points[1]:=1; points[2]:=1; {выбираем по умолчанию в каждом меню}
x1[1]:=1; x2[1]:=9; y[1]:=2;
text[1,1]:='Запуск'; text[1,2]:='Выход ';
x1[2]:=9; x2[2]:=22; y[2]:=2;
text[2,1]:='О программе';
DrawMain ('Файл Справка');
MainHelp:='ESC - Выход из программы '+'ENTER - выбор пункта меню '+ 'Стрелки - перемещение';
DrawHelp(MainHelp);
end;

procedure Work; { Рабочая процедура }
var i,kol:integer; ch:char;
begin
DrawHelp('Идет расчет...'); { Строка статуса }
textcolor (LIGHTGRAY);
textbackground (BLACK); { Выбираем цвета для работы в окне }
doubleFrame (2,2,78,24,' Расчет ');
Window (3,3,77,23);

{Секция действий, выполняемых программой}

writeln;
write ('Введите число шагов: ');
{$I-}read (kol);{$I+}
if IoResult<>0 then writeln ('Ошибка! Вы ввели не число')
else if kol>0 then begin
for i:=1 to kol do
writeln ('Выполняется шаг ',i);
writeln ('Все сделано!');
end
else writeln ('Ошибка! Число больше 0');
{Восстановление окна и выход}
Window (1,1,80,25);
DrawHelp('Нажмите любую клавишу...');
ch:=readkey;
clearFrame (2,2,78,24); { Стираем окно }
end;

procedure Out; { Очистка экрана и выход}
begin
textcolor (LIGHTGRAY);
textbackground (BLACK); clrscr; halt(0);
end;

procedure Help; {Окно с информацией}
var ch:char;
begin
textcolor (Txtcolor);
textbackground (textback);
doubleFrame (24,10,56,13,' О программе ');
DrawHelp ('Нажмите клавишу...');
gotoxy (25,11);
writeln(' Демонстрация простейшего меню');
gotoxy (25,12);
write ( ' Киев, КГУ');
ch:=readkey;
clearFrame (24,10,58,13);
end;

procedure command (Menu,Point:integer);
{Вызывает процедуры после выбора в меню }
begin
if Menu=1 then begin
if Point=1 then Work
else if Point=2 then Out;
end
else begin
if Point=1 then Help;
end;
end;

{Конец части пользователя }

procedure MainMenu (Point,
HorMenu:integer); { Поддерживает систему одноуровневых меню }
var ch: char; funckey:boolean;
begin
Points[HorMenu]:=Point;
DrawMenu (HorMenu,true);
repeat
cursor (HorMenu,Points[HorMenu],true);
ch:=readkey;
cursor (HorMenu,Points[HorMenu],false);
if ch=#0 then begin
funckey:=true; ch:=readkey;
end
else funckey:=false;
if funckey=true then begin
ch:=Upcase (ch);
if ch=#75 then begin { Стрелка влево }
DrawMenu (HorMenu,false);
HorMenu:=HorMenu-1;
if (HorMenu<1) then HorMenu:=maxMenu;
DrawMenu (HorMenu,true);
end
else if ch=#77 then begin
{ Стрелка вправо }
DrawMenu (HorMenu,false);
HorMenu:=HorMenu+1;
if (HorMenu>maxMenu) then HorMenu:=1;
DrawMenu (HorMenu,true);
end
else if ch=#72 then begin
{ Стрелка вверх }
Points[HorMenu]:=Points[HorMenu]-1;
if Points[HorMenu]<1 then
Points[HorMenu]:=Kolpoints[HorMenu];
end
else if ch=#80 then begin
{ Стрелка вниз }
Points[HorMenu]:=Points[HorMenu]+1;
if (Points[HorMenu]>KolPoints[HorMenu])
then Points[HorMenu]:=1;
end;
end
else if ch=#13 then begin
{ Клавиша ENTER }
DrawMenu (HorMenu,false);
command (HorMenu,Points[HorMenu]);
DrawMenu (HorMenu,true);
DrawHelp (MainHelp);
end;
until (ch=#27) and (funckey=false);
{ Пока не нажата клавиша ESC }
end;

{ Основная программа }

begin
Init;
MainMenu (1,1);
Out;
end.

---