Меню турбо паскаля

program menu;
 
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.