2.10.2. Приклад програми

{$М 4000,0,0} {директива компілятора, що визначає обсяг потрібної оперативної пам'яті}

program menu;

uses crt,dos;

type stroka=array [1..2] of string[10];

const {назви пунктiв горизонтального та вертикального меню}

item1:array[1..4]of string[10]=('Завдання','Програма',

'Виконання', 'Вихiд');

item2:stroka=('Лаб.poбoтa 1','Лаб.робота 2');

otstup=10; { вiдступ вiд початку рядка меню}

var i,j:integer; {лiчильник крокiв в головному меню }

kol:integer; {кiлькiсть пунктiв головного меню}

key,vertkey:char; {коди клавiш }

metca,metca2:boolean; {вихід з меню}

name:string; {iм'я файлу}

f:text; {текстовий файл}

procedure choose(a:integer);forward; {вибiр пункту головного меню}

procedure clearvert(x1,y1,x2,y2:integer;colora:integer);forward;

{************ очищення екрана ********************************}

procedure text(name:string;a:integer);forward;

{* вивiд на екран тексту завдання та програми *************}

procedure exe(name:string;a:integer);forward;

{--- виконання модуля *.ехе вiдповідно до вибраної програми ---}

procedure active(j:integer);

{------- вибiр кольору для активiзацiї пункту меню- --------}

begin

gotoxy((80 div kol)*j-otstup,1); {позицiя курсора для пункту меню}

textcolor(red); {колiр тексту}

textbackground(green); {колiр фону}

write(item1[j]); {вивiд тексту пункту меню} end;

procedure deactive(j:integer);

{---вибiр кольору для деактивiзацiї пункту меню---}

begin

gotoxy((80 div kol)*j-otstup,1);

textcolor(black); textbackground(lightgray);

write(item1[j]);

end;

procedure mainmenu ( kol:integer);

{---головне меню - передається кiлькiсть пунктiв---}

var j:integer; {допомiжна змiнна}

begin

window(1,22,80,22); {статусний рядок}

write(' ENTER-вибiр ESC-скасування ',chr(26),' ',chr(27),' - перемiщення курсора');

metca:=true; {прапорець виходу з меню}

window(1,1,80,1); textbackground(lightgray);

clrscr;

for j:=1 to kol do

begin

gotoxy((80 div kol)*j-otstup,1); {вивiд пунктiв меню}

if j=1 then active(j) {вибiр кольору для активiзацiї пункту меню}

else deactive(j); {вибiр кольору для деактивiзацiї пункту меню}

end;

j:=1; {початкове значення лiчильника пунктiв}

repeat

key:=readkey;

if (key=#0) and keypressed {аналiз коду функцiональних клавiш}

then key:=readkey;

case key of {аналiз натиснутої клавiшi}

#77: {перемiщення курсора вправо}

begin

deactive(j);

inc(j);

if j=kol+1 then j:=1; {перемiщення курсора по колу}

active(j);

end;

#75: {перемiщення курсора влiво}

begin

deactive(j);

dec(j);

if j<1 then j:=kol; { перемiщення курсора по колу}

active(j);

end;

#13: choose(j); {натиснута клавiша enter-поява спадаючого меню}

end;

until metca=false;

end; {кiнець mainmenu}

{---------------------------------------------------------------}

procedure vertmenu(kol1:integer; mas:stroka; a:integer);

{kol1-кiлькiсть пунктiв вертикального меню, mas-назва пунктiв вертикального меню, а-номер вiкна вертикального меню}

var j:integer; metca2:boolean;

{пункт меню, прапорець виходу з циклу}

procedure activevert(j:integer);

{---вибiр кольору для активiзацiї пункту меню---}

begin

gotoxy(5,j*2-1);

textcolor(red); textbackground(green); {червонi лiтери, зелений фон}

write(mas[j]);

end;

procedure deactivevert(j:integer);

{---вибiр кольору для деактивiзацiї пункту меню----}

begin

gotoxy(5,j*2-1);

textcolor(black); textbackground(lightgray); {чорнi лiтери, сiрий фон}

write(mas[j]);

end;

begin {початок процедури vertmenu} textbackground(lightgray); textcolor(black);

window((80 div kol)*a-otstup,2,(80 div kol)*(a+1)-otstup,kol1*2);

{вiкно спадаючого меню, що прив'язане до пунктiв головного меню}

clrscr;

for j:=1 to kol1 do

begin

if j=1 then activevert(j) {активiзацiя пункту вертикального меню}

else deactivevert(j); {деактивiзацiя пункту вертикального меню}

end; { }

j:=1; metca2:=true;

repeat

vertkey:=readkey; {натиснута клавiша}

if vertkey=#0 then

vertkey:=readkey; {перевiрка, чи натиснута управляюча клавiша}

case vertkey of {аналiз натиснутої управляючої клавiшi}

#80: begin {перемiщення курсора донизу}

deactivevert(J); {деактивiзацiя вертикального меню}

inc(j); {збiльшення лiчильника пунктiв меню}

if j=kol1+1 then j:=1; {якщо останнiй пункт меню, то перейти на перший} activevert(j); {активiзацiя пункту}

end;

#72:begin {перемiщення курсора догори}

deactivevert(j);

dec(j);

if j<1 then j:=kol1; {якщо перший пункт оброблений , то перейти на останнiй} activevert(j);

end;

#27: begin {натиснута клавiша ESC - очищення екрана вiд меню }

clearvert((80 div kol)*a-otstup,2,(80 div kol)*(a+1)-otstup,kol*2,0);

metca2:=false;

end;

#13:begin {натиснута ENTER}

clearvert((80 div kol)*a-otstup,2,(80 div kol)*(a+1)-otstup,kol1*2,0);

case a of {аналiз пункту головного меню}

1: begin {обробка пункту меню "Завдання"}

case j of {аналiз пункту спадаючого меню}

1: begin {вибрана 1-а команда з 1-го пункту меню}

text('t1.txt',a); break; {вивiд тексту з файлу, вихiд з case}

end;

2: begin {вибрана 2-а команда з 1-го пункту меню}

text('t2.txt',a); break;

end;

end; {case j}

end; {1:}

2: begin {обробка пункту меню "Програма"}

case j of

1: begin

text('gr1.pas',a); break; {виклик тексту програми}

end;

2: begin

text('p2.pas',a); break;

end;

end; {case j}

end; {2:}

3: begin {обробка пункту меню "Виконання"}

case j of

1: begin

exe('g:\pas\lec_menu\gr1.exe',a); break; {запуск програми на виконання}

end;

2: begin

exe('g:\pas\lec_menu\p2.exe',a); break;

end;

end; {case j}

end;

end; {case a}

end; {#13:}

end; {case vertkey}

until metca2=false;

end;

{---вибiр пунктiв головного меню та виклик спадаючого меню---}

procedure choose(a:integer);

begin case a of

1:begin

vertmenu(2,item2,1);

{поява першого вертикального меню з 2-ма пунктами}

end;

2:begin

vertmenu(2,item2,2);

end;

3:begin

vertmenu(2,item2,3);

end;

4:begin {обробка пункту меню "Вихiд"}

metca:=false;

window(1,1,80,1); {поновлення екрана}

textbackground(0); textcolor(15);

clrscr; window(1,1,80,22);

clrscr;

end;

end;

end;

procedure clearvert(x1,y1,x2,y2:integer;colora:integer);

{--очищення екрана--}

begin

textbackground(colora);

window(x1,y1,x2,y2);

clrscr; window(1,1,80,25);

end;

procedure text(name:string;a:integer);

{--реалiзацiя пункту меню - вивiд файлу на екран--}

var str:string; l: Integer;

begin

window(1,1,80,1); deactive(a); {деактивiзацiя пункту меню}

assign(f,name); {викриття файлу, iм'я передається як параметр}

reset(f);

I:=1; {лiчильник кiлькостi рядкiв, що виводяться}

window(1,22,80,22); {статусний рядок-пiдказка}

textcolor(15); textbackground(0);

clrscr;

write(' ENTER-перегляд ESC-відміна та повернення в меню') ;

window(1,3,80,21); {робоче вiкно виводу тексту}

textbackground(1); textcolor(15);

clrscr;

while not eof(f) do {поки не кiнець файлу}

begin

readln(f,str); {читати файл}

gotoxy(1,5+l); writeln(str); {писати файл на екран}

i:=i+1; {кiлькiсть рядкiв виводу на екран}

if l=15 then {пiсля виводу 15 рядкiв для продовження }

begin {виводу натиснути enter або page up}

if readkey=#27 then {якщо натиснута ESC}

begin

clrscr; break;

end;

l:=1; {вивiд нового фрагмента тексту}

clrscr;

end;

end; {while}

readkey; {очiкування натиску клавiш}

window(1,22,80,22); {очистка статусного рядка пiсля перегляду}

textcolor(15); textbackground(0);{вивiд нового повiдомлення в стат.рядку}

clrscr;

write(' ENTER-вибiр ESC-скасування ',chr(26),' ',chr(27),' -перемiщення курсора');

window(1,3,80,21); {очистка робочого екрана перегляду }

textbackground(0); clrscr;

close(f); {закрити файл}

window(1,1,80,1); active(a);{активiзацiя пункту меню}

if vertkey=#13 then choose(a); {натиснiть ENTER для виконання пункту меню}

end; {кiнець процедури text}

procedure exe(name:string;a:integer);

begin {--виконання завантажувального модуля програми-*.ехе-----}

window(1,2,80,22);

textbackground(0); textcolor(15);

swapvectors; {збереження векторiв переривання}

exec(name,''); {виклик модуля *.ехе}

swapvectors; {поновлення середовища DOS}

clrscr; window(1,1,80,1);{активiзацiя пункту меню}

textbackground(lightgray);

clrscr; active(a); deactive(1); deactive(2); deactive(4);

end;

begin {----------------головна програма----------------}

textbackground(0);

clrscr;

kol:=4;

mainmenu(kol);

end.