university-projects/praktika-pascal-2PO07
1
0
Fork 0
Code Releases 1 Activity

5

Browse Source
This commit is contained in:
aNNiMON 2024-03-02 18:43:03 +02:00
parent fc8e376329
commit b22a193573
1 changed files with 94 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

141
PRAKTIKA.PAS
View File

@ -5,8 +5,8 @@ program pr;
y_wlcm : integer; {Vsplivayushii text} y_wlcm : integer; {Vsplivayushii text}
i : integer; {Vspomogatelnie peremennye} i : integer; {Vspomogatelnie peremennye}
cur : integer; {Posicia kursora v menu} cur : integer; {Posicia kursora v menu}
x,y, stry, th : integer; {Peremennye dlya vyvoda teksta} x,y, th : integer; {Peremennye dlya vyvoda teksta}
ln, ch : integer; {Peremennye dlya chtenia teksta} ch, cf, ct : integer; {Peremennye dlya chtenia teksta}
nolect : integer; {Nomer lekcii} nolect : integer; {Nomer lekcii}
f : text; {File lekcii} f : text; {File lekcii}
javame, author, javame, author,
@ -14,23 +14,32 @@ program pr;
menustatus, tmp, menustatus, tmp,
lectstatus,path,j: string; lectstatus,path,j: string;
mainmenu : array [1..22] of string; {menu} mainmenu : array [1..22] of string; {menu}
lines : array [1..30] of string; {readtext}
{Procedura inicializacii grafiki} {Procedura inicializacii grafiki}
procedure init_screen; procedure init_screen;
begin begin
tmp_d := detect; tmp_d := detect;
initgraph(tmp_d, tmp_m, ''); initgraph(tmp_d, tmp_m, '');
if (graphresult<>0) then
begin
writeln('Graphical interface not used. Exit...');
readkey;
halt;
end;
end; end;
procedure menu ; forward; procedure menu ; forward;
procedure lections(var lect:integer); forward; procedure lections(var lect:integer); forward;
procedure ui(ttitle, tbar : string); forward; procedure ui(ttitle, tbar : string; back : integer); forward;
{Procedura inicializacii peremennyh} {Procedura inicializacii peremennyh}
procedure init_variables; procedure init_variables;
begin begin
cf := 9;
ct := 14;
x := 20; x := 20;
th := 440; {Vysota svobodnoy oblasti pri vyvode teksta} th := 400; {Vysota svobodnoy oblasti pri vyvode teksta}
y_wlcm := -20; y_wlcm := -20;
cur := 1; cur := 1;
author := 'Author: Victor aNNiMON Melnik'; author := 'Author: Victor aNNiMON Melnik';
@ -39,7 +48,7 @@ program pr;
javame := 'JavaME'; javame := 'JavaME';
lectstatus := 'F1 - Help T - Test ESC - Menu'; lectstatus := 'F1 - Help T - Test ESC - Menu';
menustatus := 'ESC - Vyhod UP,DOWN,LEFT,RIGHT - Peredvijenie kursora ENTER - Perehod'; menustatus := 'ESC - Vyhod UP,DOWN,LEFT,RIGHT - Peredvijenie kursora ENTER - Perehod';
path := 'D:\2PO-07\'; path := 'Y:\SCHOOL.PAK\2PO-07\' {'D:\TP\BIN\annimon\'};
{Menu Lekcii} {Menu Lekcii}
for i:= 1 to 10 do for i:= 1 to 10 do
begin begin
@ -88,10 +97,7 @@ program pr;
procedure author_screen; procedure author_screen;
begin; begin;
init_screen; init_screen;
ui('Authors',''); ui('Authors','',9);
{setcolor(7);
bar(0,0,640,480);}
settextstyle(1, 0, 7);
settextstyle(3, 0, 4); settextstyle(3, 0, 4);
setcolor(red); setcolor(red);
outtextxy(100, 171, author); outtextxy(100, 171, author);
@ -107,18 +113,23 @@ program pr;
procedure help_screen; procedure help_screen;
begin; begin;
init_screen; init_screen;
ui('Help',''); ui('Help','',9);
outtextxy(99, 170, 'B - Smena cveta fona'); setcolor(14);
outtextxy(99, 230, 'N - Smena cveta texta'); 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; repeat until keypressed;
menu;
end; end;
{Procedura otrisovki ekrana} {Procedura otrisovki ekrana}
procedure ui(ttitle, tbar : string); procedure ui(ttitle, tbar : string; back : integer);
begin begin
{ochistka ekrana} {ochistka ekrana}
setfillstyle(1,9); setfillstyle(1,back);
bar(0,0,640,480); bar(0,0,640,480);
{Title} {Title}
setfillstyle(1, 1); setfillstyle(1, 1);
@ -134,6 +145,40 @@ program pr;
outtextxy(10, 468, tbar); outtextxy(10, 468, tbar);
end; 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} {Procedura chtenia lectii}
procedure lections(var lect:integer); procedure lections(var lect:integer);
begin begin
@ -144,41 +189,26 @@ program pr;
reset(f); reset(f);
{Schityvaem nazvanie lekcii} {Schityvaem nazvanie lekcii}
readln(f,tmp); readln(f,tmp);
ch := TextHeight(tmp)+8; {Vysota teksta} ch := TextHeight(tmp)+12; {Vysota teksta}
ln := 1; p1:= '0';
stry := 0; readlines;
repeat p1:=readkey; repeat
{Obrabotka klavish upravlenia} {Obrabotka klavish upravlenia}
if p1=#72 then cur:=cur-2 {UP} if p1=#72 then begin reset(f); readlines; end{UP}
else if p1=#75 then x:=x-10 {LEFT} else if p1=#80 then readlines {DOWN}
else if p1=#80 then cur:=cur+2 {DOWN} else if p1=#75 then x:=x-100 {LEFT}
else if p1=#77 then x:=x+10; {RIGHT} else if p1=#77 then x:=x+100 {RIGHT}
{else if(p=#13) then cur:=cur-1; else if p1=#13 then x:=0 {ENTER}
else if(p=#72) then cur:=cur-1; else if p1='b' then changebk {color background}
else if(p=#72) then cur:=cur-1; } else if p1='n' then changetxt; {n - text color}
{Proverka peremennyh} ui(tmp,lectstatus,cf);
if(cur<2) then cur:=2
else if(cur>23) then cur:=23;
ui(tmp,lectstatus);
{Otrisovka teksta} {Otrisovka teksta}
setcolor(14); setcolor(ct);
settextstyle(4,0,3); settextstyle(2,0,5);
while not eof(f) do for i:=1 to 30 do
begin outtextxy(x,20+i*ch,lines[i]);
readln(f,s); p1:=readkey;
outtextxy(x,20+ln*ch,s); until (p1=#27) or (p1=#116) or (p1=#59);
inc(ln);
stry := stry + ch;
if (stry+ch>th) then {Dostignut nijniy kray}
begin
readkey;
ui(tmp,lectstatus);
ln:=1;
stry:=0;
end;
end;
until (p1=#27) or (p1=#116) or (p1=#59)
{ or (p=#80) or (p=#80) or (p=#13)};
if(p1=#116) then menu {T - Test} if(p1=#116) then menu {T - Test}
else if(p1=#59) then help_screen; {F1 - Help} else if(p1=#59) then help_screen; {F1 - Help}
end; end;
@ -199,7 +229,8 @@ program pr;
procedure menu; procedure menu;
begin begin
init_screen; init_screen;
repeat p:=readkey; p := '.';
repeat
{Obrabotka klavish upravlenia} {Obrabotka klavish upravlenia}
if p=#72 then cur:=cur-2 {UP} if p=#72 then cur:=cur-2 {UP}
else if p=#75 then cur:=cur-1 {LEFT} else if p=#75 then cur:=cur-1 {LEFT}
@ -207,9 +238,9 @@ program pr;
else if p=#77 then cur:=cur+1 {RIGHT} else if p=#77 then cur:=cur+1 {RIGHT}
else if p=#13 then choicemenu(cur); {ENTER} else if p=#13 then choicemenu(cur); {ENTER}
{Proverka peremennyh} {Proverka peremennyh}
if(cur<2) then cur:=2; if(cur<2) then cur:=2
if(cur>23) then cur:=23; else if(cur>23) then cur:=23;
ui(javame, menustatus); ui(javame, menustatus,9);
{Otrisovka menu} {Otrisovka menu}
setcolor(14); setcolor(14);
settextstyle(1,0,3); settextstyle(1,0,3);
@ -225,9 +256,9 @@ program pr;
outtextxy(120, 40+i*30, mainmenu[i*2-1]); outtextxy(120, 40+i*30, mainmenu[i*2-1]);
outtextxy(320, 40+i*30, mainmenu[i*2]); outtextxy(320, 40+i*30, mainmenu[i*2]);
end; end;
until (p=#27) {or (p=#72) or (p=#75) or (p=#77) p:=readkey;
or (p=#80) or (p=#80) or (p=#13)}; until (p=#27);
if(p=#27) then halt; halt;
end; end;
{Glavnaya programma} {Glavnaya programma}