написанные программы / задание №4 — 7 / PRO4

program pro4_version2;
uses Crt;
type TArr=array [1..36] of string[18];
var Nam,Nam1:TArr;
n:array [1..6] of Byte;
x,y,i,j,nc,s:Integer;
Ch:Char;
f:Text;

procedure Environment;
var M:TArr;
label 1;
begin
TextBackground(7);
TextColor(0);
Write(' inners nput card hecking cards Change layer elp uit ');
gotoXY(1,24);
Writeln(' Type marked letter + Enter to open, "D" + Enter to close section ');
TextColor(4);
gotoXY(2,1); Write('W'); gotoXY(11,1); Write('I'); gotoXY(23,1); Write('C');
gotoXY(46,1); Write('p'); gotoXY(54,1); Write('H'); gotoXY(60,1); Write('Q');
TextBackground(0);
TextColor(7);
gotoXY(1,2);
Write('ЙННННННЛННННННННННННННННННННЛ'); for i:=1 to 49 do Write('Н');
Writeln('»');
for i:=1 to 11 do begin
Writeln('є є є є');
end;
Writeln('є є МННННННЛНННННННННННННННННЛННННННЛННННННННННННННННН№');
for i:=11 to 18 do begin
Writeln('є є є є є є є');
end;
Write('ИННННННКННННННННННННННННННННКННННННКНННННННННННННННННКННННННКНННННННННННННННННј');
TextBackground(0);
TextColor(0);
end;

procedure CloseSection;
label 1;
begin
1: gotoXY(1,23);
TextBackground(0);
TextColor(0);
Readln(Ch);
if UpCase(Ch) = 'D' then clrscr else goto 1;
end;

procedure Winners;
label 1,2;
begin
clrscr;
Environment;
TextBackground(7);
TextColor(0);
gotoXY(1,24);
Write('If you want to input winners press " " or " " to see old ones ');
TextColor(4);
gotoXY(37,24); Write('I'); gotoXY(44,24); Write('O');
TextBackground(0);
TextColor(0);
gotoXY(80,23);
Readln(Ch);
if UpCase(Ch) = 'D' then goto 2;
if UpCase(Ch) = 'O' then goto 1
else if UpCase(Ch) = 'I' then begin
TextColor(7);
y:=3;
for i:=1 to 6 do begin
gotoXY(4,y); Write(' ',i,' ');
gotoXY(10,y); Readln(Nam[i]);
y:=y+1;
end;
end;

for i:=1 to 6 do begin
for j:=36 downto 1 do begin
if Nam[i]=Nam1[j] then s:=s+1;
end;
end;

if s<>6 then begin
gotoXY(31,3);
Write('Twice indicated players or they do not');
gotoXY(31,4); Write('fit the list. Try again or change players.');
end;
1: TextColor(7);
y:=3;
for i:=1 to 6 do begin
gotoXY(4,y); Write(' ',i,' ');
gotoXY(10,y); Writeln(Nam[i]);
y:=y+1;
end;
CloseSection;
2: end;


procedure List;
begin
TextColor(2);
for i:=1 to 6 do begin
for j:=1 to 20 do begin
if (Nam[i] = Nam1[j]) then begin
gotoXY(3,j+2); Write('*');
end;
end;
for j:=21 to 29 do begin
if (Nam[i] = Nam1[j]) then begin
gotoXY(31,j-6); Write('*');
end;
end;
for j:=30 to 36 do begin
if (Nam[i] = Nam1[j]) then begin
gotoXY(56,j-14); Write('*');
end;
end;

end;
TextColor(7);
y:=3;
for i:=1 to 20 do begin
gotoXY(4,y); Write(' ',i,' ');
gotoXY(10,y); Write(' ',Nam1[i]);
y:=y+1;

end;

y:=15;
for i:=21 to 28 do begin
gotoXY(32,y); Write(' ',i,' ');
gotoXY(37,y); Write(' ',Nam1[i]);
y:=y+1;
end;
y:=15;
for i:=29 to 36 do begin
gotoXY(57,y); Write(' ',i,' ');
gotoXY(62,y); Write(' ',Nam1[i]);
y:=y+1;
end;
end;

procedure InputCard;
begin
TextColor(0);
TextBackground(7);
gotoXY(1,24);
Writeln(' Input numbers of the marked names on card, when done, press Enter.');
TextBackground(5);
TextColor(14);
gotoXY(35,5);
Writeln('ЙНННННННННННННННННННННН»');
gotoXY(35,6);
Writeln('є Input Card є');
gotoXY(35,7);
Writeln('МНННННННННННННННННННННН№');
x:=7;
Inc(x);
gotoXY(35,x);
Write(' ');
gotoXY(35,x);
Write('є Card Number: '); Readln(nc);
gotoXY(52,x);
Write(' є');
for i:=1 to 6 do
begin
Inc(x);
gotoXY(35,x);
Write(' ');
gotoXY(35,x);
Write('є ',i,') '); Readln(n[i]);
gotoXY(50,x);
Write(' є');
end;
Inc(x);
gotoXY(35,x);
Writeln('ИННННННННННННННННННННННј');
CloseSection;
end;

procedure Winner;
begin
TextBackground(4);
TextColor(128);
gotoXY(35,8);
Writeln(' WINNER!');
end;

procedure CheckCards;
begin
TextColor(7);
s:=0;
for j:=1 to 6 do begin
for i:=1 to 6 do begin
if Nam[i] = Nam1[n[j]] then s:=s+1;
end;
end;
gotoXY(31,3); Write(' ',s,' players indicated properly');
gotoXY(31,4); Write(' Card number ',nc);
if s=6 then Winner;
CloseSection;
end;

procedure ChangePlayer;
var n2:Byte;
begin
gotoXY(31,3); Write('Number of changing player: '); Readln(n2);
gotoXY(31,4); Write('New name: '); Readln(Nam1[n2]);
gotoXY(31,5); Write('Take into account that new name will not be');
gotoXY(31,6); Write('saved in origin file!');
CloseSection;
end;

procedure Help;
begin
TextBackground(11);
TextColor(0);
gotoXY(21,5);
Writeln('ЙНННННННННННННННННННННННННННННННННННННН»');
gotoXY(21,6);
Writeln('є Program function is checking of є');
gotoXY(21,7);
Writeln('є the lottery cards. Input winners of є');
gotoXY(21,8);
Writeln('є the competition in section "Winners" є');
gotoXY(21,9);
Writeln('є from keyboard, marked names on card є');
gotoXY(21,10);
Writeln('є and its number in "Input Card". є');
gotoXY(21,11);
Writeln('є You can get results in "Checking є');
gotoXY(21,12);
Writeln('є Cards": number of the present card є');
gotoXY(21,13);
Writeln('є and number of guessed names. If all є');
gotoXY(21,14);
Writeln('є sporstmen were indicated in the card є');
gotoXY(21,15);
Writeln('є correctly, a word WINNER! will be є');
gotoXY(21,16);
Writeln('є written below. To change players in є');
gotoXY(21,17);
Writeln('є the list use "Change player" section є');
gotoXY(21,18);
Writeln('є and to exit program use "Quit" є');
gotoXY(21,19);
Writeln('є section, where type "Y" to confirm є');
gotoXY(21,20);
Writeln('є or abolish going out. є');
gotoXY(21,21);
Writeln('ИННННННННННННННННННННННННННННННННННННННј');
CloseSection;
end;

procedure Quit;
label 1;
begin
TextBackground(7);
TextColor(0);
gotoXY(1,24);
Writeln(' Press "Y" or "N" when choice done, then press Enter. ');
TextBackground(6);
TextColor(15);
gotoXY(20,17);
Writeln('ЙННННННННННННННННННННННННННННННННННННННННН»');
gotoXY(20,18);
Writeln('є Are you sure you want to quit? є');
gotoXY(20,19);
Writeln('є Yes(Y)/No(N) є');
gotoXY(20,20);
Writeln('ИНННННННННННННННННННННННННННННННННННННННННј');

1: gotoXY(1,23);
TextBackground(0);
TextColor(0);
Readln(Ch);

if (UpCase(Ch) = 'N') or (UpCase(Ch) = 'D') then clrscr else
if UpCase(Ch) = 'Y' then begin
clrscr;
TextBackground(0);
TextColor(7);
close(f);
Halt;
end
else goto 1;
end;



begin
clrscr;
assign(f,'C:\pro4_v2d.txt');
Reset(f);
for i:=1 to 36 do begin
Read(f,Nam1[i]); Readln(f);
end;
Environment;
List;
TextBackground(0);
TextColor(0);
repeat
gotoXY(80,23);
Readln(Ch);
if UpCase(Ch) = 'W' then Winners;
if UpCase(Ch) = 'I' then InputCard;
if UpCase(Ch) = 'C' then CheckCards;
if UpCase(Ch) = 'P' then ChangePlayer;
if UpCase(Ch) = 'H' then Help;
if UpCase(Ch) = 'Q' then Quit;
clrscr;
Environment;
List;
until UpCase(Ch) = 'Q';
end.