praktika-pascal-2PO07/PRAKTIKA.PAS
2024-03-02 18:43:03 +02:00

270 lines
8.0 KiB
Plaintext

program pr;
uses crt, graph;
var tmp_d, tmp_m : integer; {screen variables}
p,p1 : char; {readkey}
y_wlcm : integer; {Vsplivayushii text}
i : integer; {Vspomogatelnie peremennye}
cur : integer; {Posicia kursora v menu}
x,y, th : integer; {Peremennye dlya vyvoda teksta}
ch, cf, ct : integer; {Peremennye dlya chtenia teksta}
nolect : integer; {Nomer lekcii}
f : text; {File lekcii}
javame, author,
welcome, dtpa, s,
menustatus, tmp,
lectstatus,path,j: string;
mainmenu : array [1..22] of string; {menu}
lines : array [1..30] of string; {readtext}
{Procedura inicializacii grafiki}
procedure init_screen;
begin
tmp_d := detect;
initgraph(tmp_d, tmp_m, '');
if (graphresult<>0) then
begin
writeln('Graphical interface not used. Exit...');
readkey;
halt;
end;
end;
procedure menu ; forward;
procedure lections(var lect:integer); forward;
procedure ui(ttitle, tbar : string; back : integer); forward;
{Procedura inicializacii peremennyh}
procedure init_variables;
begin
cf := 9;
ct := 14;
x := 20;
th := 400; {Vysota svobodnoy oblasti pri vyvode teksta}
y_wlcm := -20;
cur := 1;
author := 'Author: Victor aNNiMON Melnik';
dtpa := 'DTPA 2PO-07';
welcome := 'Welcome';
javame := 'JavaME';
lectstatus := 'F1 - Help T - Test ESC - Menu';
menustatus := 'ESC - Vyhod UP,DOWN,LEFT,RIGHT - Peredvijenie kursora ENTER - Perehod';
path := 'Y:\SCHOOL.PAK\2PO-07\' {'D:\TP\BIN\annimon\'};
{Menu Lekcii}
for i:= 1 to 10 do
begin
str(i, tmp);
mainmenu[i*2-1] := 'Lekcia #'+tmp;
mainmenu[i*2] := 'Test #'+tmp;
end;
mainmenu[21] := 'Author';
mainmenu[22] := 'Exit';
end;
{Procedura vyvoda zastavki}
procedure helloscreen;
begin
init_screen;
repeat
setcolor(7);
bar(0,0,640,480);
settextstyle(1, 0, 7);
{vyvod texta Welcome s tenyu}
setcolor(green);
outtextxy(192, y_wlcm+2, welcome);
setcolor(lightgreen);
outtextxy(190, y_wlcm, welcome);
inc(y_wlcm);
{Vyvod imeni}
settextstyle(3, 0, 4);
setcolor(red);
outtextxy(y_wlcm*2-100, 281, author);
setcolor(lightred);
outtextxy(y_wlcm*2-99, 280,author);
delay(1000);
{Vyvod nazvania}
settextstyle(6,0,8);
setcolor(lightblue);
for i:= 1 to 6 do
begin
if(y_wlcm/16)<i then break;
outtextxy(70+i*60, 120, javame[i]);
end;
until (y_wlcm>100) or (keypressed);
readkey;
end;
{Vyvod info ob avtore}
procedure author_screen;
begin;
init_screen;
ui('Authors','',9);
settextstyle(3, 0, 4);
setcolor(red);
outtextxy(100, 171, author);
outtextxy(240, 231, dtpa);
setcolor(lightred);
outtextxy(99, 170,author);
outtextxy(239, 230, dtpa);
repeat until keypressed;
menu;
end;
{Vyvod pomoschi pri chtenii lekcii}
procedure help_screen;
begin;
init_screen;
ui('Help','',9);
setcolor(14);
settextstyle(2,0,7);
outtextxy(99, 110, 'UP - Chtenie lekcii s nachala');
outtextxy(99, 150, 'DOWN - Sleduyuschaya stranica');
outtextxy(99, 190, 'LEFT/RIGHT - Sdvinut tekst vlevo/vpravo');
outtextxy(99, 230, 'ENTER - Normalnoe vyravnivanie teksta');
outtextxy(99, 270, 'B - Smena cveta fona');
outtextxy(99, 310, 'N - Smena cveta texta');
repeat until keypressed;
end;
{Procedura otrisovki ekrana}
procedure ui(ttitle, tbar : string; back : integer);
begin
{ochistka ekrana}
setfillstyle(1,back);
bar(0,0,640,480);
{Title}
setfillstyle(1, 1);
bar(0, 0, 640, 18);
setcolor(13);
settextstyle(2,0,6);
outtextxy(300, 0, ttitle);
{Status}
setfillstyle(1, 7);
settextstyle(2,0,4);
bar(0, 466, 640, 480);
setcolor(24);
outtextxy(10, 468, tbar);
end;
{Chtenie strok iz faila}
procedure readlines;
var numl : integer;
begin
numl := 1;
if not eof(f) then
begin
repeat
readln(f, lines[numl]);
inc(numl);
until eof(f) or (numl>(th div ch)) or (numl>30);
{Ostalnie zapolnyayem probelami}
for i:= numl to 30 do lines[i] := '';
end;
end;
{Smena cveta fona}
procedure changebk;
begin
inc(cf);
if(cf=ct) then inc(cf);
if(cf>16) then cf:=0;
if(cf=ct) then inc(cf);
end;
{Smena cveta teksta}
procedure changetxt;
begin
inc(ct);
if(ct=cf) then inc(ct);
if(ct>16) then ct:=0;
if(ct=cf) then inc(ct);
end;
{Procedura chtenia lectii}
procedure lections(var lect:integer);
begin
init_screen;
nolect := lect div 2;
str(nolect, tmp);
assign(f, path+'lect'+tmp+'.txt');
reset(f);
{Schityvaem nazvanie lekcii}
readln(f,tmp);
ch := TextHeight(tmp)+12; {Vysota teksta}
p1:= '0';
readlines;
repeat
{Obrabotka klavish upravlenia}
if p1=#72 then begin reset(f); readlines; end{UP}
else if p1=#80 then readlines {DOWN}
else if p1=#75 then x:=x-100 {LEFT}
else if p1=#77 then x:=x+100 {RIGHT}
else if p1=#13 then x:=0 {ENTER}
else if p1='b' then changebk {color background}
else if p1='n' then changetxt; {n - text color}
ui(tmp,lectstatus,cf);
{Otrisovka teksta}
setcolor(ct);
settextstyle(2,0,5);
for i:=1 to 30 do
outtextxy(x,20+i*ch,lines[i]);
p1:=readkey;
until (p1=#27) or (p1=#116) or (p1=#59);
if(p1=#116) then menu {T - Test}
else if(p1=#59) then help_screen; {F1 - Help}
end;
{Procedura obrabotki vibrannogo punkta menu}
procedure choicemenu(var cur:integer);
begin
if(cur=22) then author_screen {AUTHOR}
else if(cur=23) then halt {EXIT}
else {OTHER}
begin
if cur mod 2=0 then lections(cur)
;{else question(cur div 2);}
end;
end;
{Procedura vyvoda menu}
procedure menu;
begin
init_screen;
p := '.';
repeat
{Obrabotka klavish upravlenia}
if p=#72 then cur:=cur-2 {UP}
else if p=#75 then cur:=cur-1 {LEFT}
else if p=#80 then cur:=cur+2 {DOWN}
else if p=#77 then cur:=cur+1 {RIGHT}
else if p=#13 then choicemenu(cur); {ENTER}
{Proverka peremennyh}
if(cur<2) then cur:=2
else if(cur>23) then cur:=23;
ui(javame, menustatus,9);
{Otrisovka menu}
setcolor(14);
settextstyle(1,0,3);
for i:= 1 to 11 do
begin
if(i=cur div 2) then
begin
setfillstyle(1,3);
if (cur mod 2=0) then bar(115, 35+i*30, TextWidth(mainmenu[i*2-1])+125, 35+(i+1)*30)
else bar(315, 35+i*30, TextWidth(mainmenu[i*2])+325, 35+(i+1)*30);
setfillstyle(1,7);
end;
outtextxy(120, 40+i*30, mainmenu[i*2-1]);
outtextxy(320, 40+i*30, mainmenu[i*2]);
end;
p:=readkey;
until (p=#27);
halt;
end;
{Glavnaya programma}
begin
init_variables;
helloscreen;
menu;
closegraph;
end.