Скачиваний:
127
Добавлен:
08.05.2014
Размер:
5.88 Кб
Скачать
program exp3;
uses Crt;
var Ch:Char; i,j,k,r,w,Number,mlp1,mlp2:Byte; dat1:array[1..12] of Byte;
check:array[1..2,1..10]of Byte; f:Text;
names:array[1..10] of string[10]; name:string[10];
marks:array[1..10] of Byte; mrk:Byte;
procedure OriginData;
begin
for i:=1 to 12 do
dat1[i]:=i;
end;

procedure Variants(l:Byte);
label 1;
begin
1: i:=Trunc(Random(12)); if i=0 then i:=1;
j:=Trunc(Random(12)); if j=0 then Inc(j);
for k:=1 to 10 do begin
if ((dat1[i]=check[1,k]) and (dat1[j]=check[2,k])) or
((dat1[i]=check[2,k]) and (dat1[j]=check[1,k])) then goto 1;
end;
check[1,l]:=dat1[i]; check[2,l]:=dat1[j];
mlp1:=dat1[i]; mlp2:=dat1[j];
end;

procedure ClearWindow;
begin
TextBackground(0);
for i:=1 to 17 do begin
gotoXY(3,3+i); for j:=1 to 69 do Write(' ');
end;
TextColor(7);
end;

procedure ReadFile;
begin
Reset(f); i:=1;
while not Eof(f) do begin
Readln(f,names[i]);
if names[i]='' then Exit;
Readln(f,marks[i]);
Number:=i; Inc(i);
end;
end;

procedure RenewFile;
begin
Rewrite(f);
for i:=1 to number do begin
Writeln(f,names[i]); Writeln(f,marks[i]);
end;
Close(f); ReadFile;
end;

procedure LookThrough;
begin
ReadFile; TextColor(7);
for i:=1 to Number do begin
gotoXY(3,3+i); Write(names[i],' '); Writeln(marks[i]);
end;
Readkey; ClearWindow;
end;

procedure Environment;
var i,j:Word;
begin
TextColor(7); TextBackground(0);
gotoXY(1,1);
Write('Й'); for i:=1 to 77 do Write('Н'); Writeln('»');
Write('є Test Journal Quit');
for i:=1 to 56 do Write(' '); Writeln('є');
Write('М'); for i:=1 to 77 do Write('Н'); Writeln('№');
for i:=1 to 17 do begin
Write('є'); for j:=1 to 77 do Write(' '); Writeln('є');
end;
Write('М'); for i:=1 to 77 do Write('Н'); Writeln('№');
for i:=1 to 2 do begin
Write('є'); for j:=1 to 77 do Write(' '); Writeln('є');
end;
Write('И'); for i:=1 to 77 do Write('Н'); Writeln('ј');
TextColor(4); gotoXY(4,2); Write('T'); gotoXY(10,2); Write('J');
gotoXY(19,2); Write('Q'); TextColor(7);
end;

procedure Test;
var num:Byte; product:Integer; wr,wr1,found:Boolean;

procedure TestResult;
var Mark:Byte;
label 1;
begin
ClearWindow;
TextBackground(13); TextColor(0);
gotoXY(25,5); Write('ЙНННННННННННННННННННННННННННННН»');
gotoXY(25,6); Write('є Test Results є');
gotoXY(25,7); Write('МНННННННННННННННННННННННННННННН№');
gotoXY(25,8); Write('є Right: є');
gotoXY(25,9); Write('є Wrong: є');
gotoXY(25,10); Write('є Mark: є');
gotoXY(25,11); Write('є є');
gotoXY(25,12); Write('є Ok є');
gotoXY(25,13); Write('ИННННННННННННННННННННННННННННННј'); TextColor(4);
gotoXY(49,12); Write('O'); TextColor(0);
gotoXY(35,8); Write(r); gotoXY(35,9); Write(w); name:='';
if (r-w=10) then mark:=5 else
if (r-w=9) then mark:=4 else
if (r-w>6) and (r-w<10) then mark:=3 else
mark:=2;
gotoXY(35,10); Write(mark);
1: gotoXY(29,12); Write('Surname: '); Readln(name);
for i:=1 to number do begin
if names[i]=name then begin marks[i]:=mark;
found:=true; Break; end
else found:=false;
end;
if found=false then begin
gotoXY(29,12); Write('data incorrect ');
Ch:=Readkey; if Ord(Ch)=27 then Exit;
gotoXY(29,12); Write(' ');
goto 1;
end; Renewfile;
mark:=0;
end;

procedure Right;
begin
gotoXY(27,12); TextBackground(2); TextColor(128);
Write(' Џа ўЁ«м­®! '); Inc(r);
TextBackground(7); TextColor(0); Readkey; wr1:=false;
gotoXY(27,12); Write(' ');
end;

procedure Wrong;
begin
gotoXY(27,12); TextBackground(4); TextColor(128);
Write(' ЌҐЇа ўЁ«м­®! '); Readkey; Inc(w); wr:=true;
TextBackground(7); TextColor(0);
gotoXY(27,12); Write(' ');
end;

procedure CheckInput;
begin
if product=mlp1*mlp2 then Right else Wrong;
end;

label 1;
begin
TextBackground(7); TextColor(0);
gotoXY(25,5); Write('ЙНННННННННННННННННННННННННННННН»');
gotoXY(25,6); Write('є Test є');
gotoXY(25,7); Write('МНННННННННННННННННННННННННННННН№');
gotoXY(25,8); Write('є ЙННННННННННННННННННННН» є');
gotoXY(25,9); Write('є є є є');
gotoXY(25,10); Write('є ИНННННННННННННННННННННј є');
gotoXY(25,11); Write('є є');
gotoXY(25,12); Write('є Cancel є');
gotoXY(25,13); Write('ИННННННННННННННННННННННННННННННј'); TextColor(4);
gotoXY(49,12); Write('C'); TextColor(0); num:=1; r:=0; w:=0;
wr:=False;
{$I-}
repeat
Variants(num);
gotoXY(28,9); Write(mlp1,' * ',mlp2,' = '); gotoXY(51,9);
Write('N',num:2);
repeat
1: gotoXY(40,9); Readln(product); CheckInput;
if wr=True then begin wr:=False; wr1:=true; goto 1; end;
if wr1=True then begin r:=r-1; wr1:=false; end;
Ch:=readkey;
if UpCase(Ch) = 'C' then begin ClearWindow; Exit; end;
until IOResult=0;
Inc(num); gotoXY(28,9); Write(' ');
until (Ch = #13) and (num=11);
{$I+}
TestResult; Readkey; Environment;
end;

begin
clrscr;
Assign(f,'exp3_dat.txt');
OriginData; Environment; Readfile;
while True do begin
Ch:=readkey;
case UpCase(Ch) of
'T':Test;
'Q':halt;
'J':LookThrough;
end;
end;
end.












Соседние файлы в папке задание №4 — 7