Код:
Program Template;
Uses Crt;
Const
kol = 8; { количество элементов меню }
Var
ch :char;{ код нажатой клавиши }
N, { номер выбранного элемента меню }
old:byte;
(* Spisok - массив с названием элементов меню *)
const spisok:array[1..kol] of string[10]=('Файл','Правка',
'Поиск','Компиляция','Отладка','Пуск','Настройки','Помощь');
(*--------------------------------------------------*)
(* подпрограмма формирования рамки *)
(* переменные : *)
(* contur-параметры вида линий рамки *)
(* name - имя для меню *)
(* fonr - цвет для заполнения окна с рамкой *)
(* colr - цвет символов линий рамки окна *)
(*--------------------------------------------------*)
Procedure Ramka(x1,y1,x2,y2:word;fonr,colr:byte;contur,
name:string);
var k:integer;
begin
window(1,1,80,25); { установка полного экрана }
TextColor(colr);
TextBackGround(fonr);
GotoXY(x1,y1);
write(contur[1]);
for k:=x1+1 to x2-1 do
write(contur[5]);
write(contur[2]);
GotoXY(x1+trunc((x2-x1-Length(name))/2),y1);
write(name); { вывод названия меню }
for k:=y1+1 to y2-1 do
begin
GotoXY(x2,k);write(contur[6]);
GotoXY(x1,k);write(contur[6])
end;
GotoXY(x1,y2);
write(contur[3]);
for k:=x1+1 to x2-1 do
write(contur[5]);
write(contur[4]);
Window(x1+1,y1+1,x2-1,y2-1); { установка и очистка окна}
clrscr; { ограниченного рамкой }
end;
(*--------------------------------------------------*)
(* Подпрограмма формирующая меню команд *)
(* переменные : *)
(* Кординаты X1,Y1 - верхий левый угол *)
(* X2,Y2 - правый нижний угол *)
(* Цвета FonR - цвет фона рамки *)
(* ColR - цвет рамки *)
(* FonS - цвет фона строки *)
(* ColS - цвет строки *)
(*--------------------------------------------------*)
Procedure NewMenu(var number:byte; x1,y1,x2,y2:word;
fonr,colr,fons,cols:byte;
contur,name:string);
const
Enter = #13; { выбор пункта меню }
Esc = #27; { отмена работы с меню}
sdvig = #0; { признак управляющей клавиши }
Up = #72; { вверх по меню }
Down = #80; { вниз по меню }
Var
CopyAttr:array[1..2] of byte; { атрибуты цветности }
old : byte;
x,y : word;
ch : char;
n,
newkursor : integer;
Begin
old:=TextAttr;
Number:=0;
Ramka(x1,y1,x2,y2,fonr,colr,'╔╗╚╝═║',' Меню ');
GotoXY(30,1);
CopyAttr[1]:=TextAttr;
writeln;
n:=0;
while n<8 do
begin
n:=n+1;
GotoXy(1,n+1);writeln(' ':4,spisok[n]);
end;
newkursor:=1; n:=1;
GotoXY(1,newkursor+1);
TextColor(cols);
TextBackGround(fons);
CopyAttr[2]:=TextAttr;
write(' ':4,spisok[1]); ClrEol; { подсветка первого
элемента меню }
repeat
ch:=readkey;
if ch=sdvig
then begin
ch:=readkey;
case ch of
{ переход на один элемент вверх }
up : begin
newkursor:=n-1;
if newkursor=0 then newkursor:=kol
end;
{ переход на один элемент вниз }
down : begin
newkursor:=n+1;
if newkursor=kol+1 then newkursor:=1
end
end;
{ снять выделение старого пункта иеню }
GotoXY(1,n+1);
TextAttr:=CopyAttr[1];
write(' ':4,spisok[n]);
ClrEol;
{ выделить новый пункт меню }
{ световым пятном }
TextAttr:=CopyAttr[2];
GotoXY(1,newkursor+1);
write(' ':4,spisok[newkursor]);
ClrEol;
n:=newkursor;
end
until (ch=enter)or(ch=Esc) ;
if ch=Enter then Number:=n;
TextAttr:=old;
end;
(*--------------------------------------------------*)
(* подпрограмма формирующая подсказки *)
(*--------------------------------------------------*)
procedure help;
begin
ramka(1,21,80,24,10,14,'╔╗╚╝═║',' ВЫБОР КЛАВИШ ');
GotoXY(1,1);
writeln(' ':10,'ENTER - выбор команды Esc - выход из меню');
write(' ':10,'CТРЕЛКИ (вверх,вниз)-выбор пункта меню');
end;
(*--------------------------------------------------*)
(* Основная программа *)
(*--------------------------------------------------*)
Begin
old:=lastmode;
Clrscr;
(* Окно редактора *)
Ramka(1,2,80,24,Blue,White,'╔╗╚╝═║',' Здесь будет имя файла ');
(* Меню *)
NewMenu(N,27,4,52,20,13,14,3,8,'╔╗╚╝═║','---------');
if N=8 then
{ вывод подсказки }
begin
Help;
end
else
Ramka(20,15,60,18,3,15,'╔╗╚╝═║',' РЕЗУЛЬТАТ ');
write(' выбран элемент меню :',Spisok[N]);
ch:=readkey;
textmode(old);
end.