Umiestnenie súboru www.TrSek.com/pas/testuj.pas{ TESTUJ.PAS Copyright (c) TrSek alias Zdeno Sekerak }
{ Program urceny na testovanie ziakov z roznych predmetov. }
{ Pre svoju cinnost potrebuje subor test.txt a vytvara subory s }
{ koncovkou tes. Format suboru testuj.cfg najdete v subore }
{ testuj.txt. }
{ }
{ Datum:08.11.2005 http://www.trsek.com }
program testovanie_ziakov;
uses crt,dos;
const TST_MENO='testuj.cfg'; { takto sa vola subor s testom }
ZIAK_ZOZ='ziaci.txt'; { zoznam testovanych ziakov }
TST_KON='.tes'; { koncovka s vysledkom testu }
var o:char;
cesta,test:string; { cesta odkial je spusteny program }
mt1,mt2:string; { meno testu 1,2 riadok }
meno:string; { meno skusaneho ziaka }
znam:array[1..5,1..2] of byte; { rozsah bodov pre znamky }
odp :array[1..4] of byte; { body za aktualne odpovede }
pb:byte; { celkovy pocet bodov }
po:byte; { pocet otazok }
px,py:byte; { pozicia vypisovania textu na obrazovku }
{ zisti ci existuje subor }
function JeSubor(txtfile:string):boolean;
var f:text;
begin
{$I-} { - zakaze vypisovanie chyb }
Assign(f,cesta+txtfile);
Reset(f);
Close(f);
{$I+}
{ zisti cestu odkial je program spustany }
function DajCestu:string;
var s:string;
i:integer;
begin
s:=ParamStr(0);
i:=Length(s);
while((i>0) and (s[i]<>'\')) do
begin
Delete(s,i,1);
i:=i-1;
end;
DajCestu:=s;
end;
{ zlucuje textbackground a textcolor }
procedure farba(x,y:integer);
begin
textbackground(x);
textcolor(y);
end;
{ zlucuje procedury gotoxy() a write() }
procedure WriteXY(x,y:integer;tex:string);
begin
gotoxy(x,y);
write(tex);
end;
{ prevedie retazec na cislo }
function ToInt(s:string):integer;
var i,err:integer;
begin
Val(s,i,err);
ToInt:=i;
end;
{ prevedie cislo na retazec }
function ToStr(i:integer):string;
var s:string;
begin
Str(i,s);
ToStr:=s;
end;
{ prevedie vsetky znaky na velke pismena }
function SUpCase(s:string):string;
var i:integer;
begin
for i:=1 to Length(s) do
s[i]:=UpCase(s[i]);
SUpCase:=s;
end;
{ pocka na stlaceni klavesu }
procedure Pause;
begin
farba(black,lightgray);
WriteXY(10,22, 'Stlac klaves <ENTER> pre pokracovanie.');
ReadKey;
end;
{ oddeli od retazca prev slovo az po medzeru }
function DivPos(var s:string):string;
var pom:string;
i:integer;
begin
{ najdeme prvu medzeru }
i:=Pos(' ',s);
if (i=0) then begin
pom:=s;
s:='';
end
else begin
pom:=Copy(s,1,i-1);
{ zmazeme zaciatocne slovo }
Delete(s,1,i);
end;
DivPos:=pom;
end;
{ precita zo suboru meno testu, pocet bodov }
{ znamkove hodnotenie, a spocita celkovy pocet bodov }
procedure AnalyzeTest;
var f:text;
s:string;
i,max:integer;
odpoved:boolean;
begin
if not(JeSubor(test)) then
begin
Writexy(10,5,'Subor s testom ' +test+ ' neexistuje.');
Writexy(10,6,'Nebude mozne pokracovat v programe.');
pause;
exit;
end;
{ budeme hladat pocet otazok a spocitame maximalny pocet bodov }
while (not(eof(f))) do
begin
ReadLn(f,s);
{ tu zacina otazka }
if (s='+') then begin
po:=po+1;
pb:=pb+max;
max:=0;
odpoved:=false;
end;
{ ak su to otazky zistujem pocet bodov }
if (odpoved) then begin
i:=ToInt(DivPos(s));
if (i>max) then max:=i;
end;
{ tu zacinu odpovede }
if (s='-') then
odpoved:=true;
end;
po:=po-1; { posledne plus neratam }
Close(f);
end;
{ podla mnozstva bodov urci znamku }
function Oznamkuj(body:integer):byte;
var i,zn:integer;
begin
zn:=5;
for i:=1 to 5 do
if((znam[i,1]>=body) and (znam[i,2]<=body)) then
zn:=i;
Oznamkuj:=zn;
end;
{ uvodna obrazovka }
procedure Uvod(typ,ot,body,cbody:integer);
begin
clrscr;
{ vypise nazov testu }
farba(blue,yellow);
writexy(10,4,mt1);
writexy(10,5,mt2);
farba(black,lightgray);
if(typ=0) then begin
writexy(10,7,'1. Spusti test');
writexy(10,8,'2. Zobraz vysledky ziakov');
writexy(10,9,'3. Koniec');
end;
if(typ=1) then begin
writexy(10,6,'Otazka : ' + ToStr(ot) + ' z '+ ToStr(po));
writexy(10,7,'Pocet bodov : ' + 'spolu '+ ToStr(pb));
writexy(10,8,'Meno ziaka : ' + meno +' ');
end;
if(typ=3) or (typ=4) then begin
writexy(10,6,'Otazka : ' + ToStr(ot) + ' z '+ ToStr(po));
writexy(10,7,'Pocet bodov : ' + ToStr(body) + ' z '+ ToStr(cbody));
writexy(10,8,'Meno ziaka : ' + meno +' ');
Writexy(10,9,'Znamka : ' + ToStr(Oznamkuj(cbody)));
end;
if(typ=4) then
Writexy(10,9,'Znamka : ' + ToStr(Oznamkuj(body)));
end;
{ zapise meno noveho ziaka a povie aky je v poradi }
function NovyZiak(s:string):integer;
var f:text;
por:integer;
pom:string;
begin
{ ak neexistuje zalozim novy }
if not(JeSubor(ZIAK_ZOZ)) then begin
Assign(f,cesta+ZIAK_ZOZ);
ReWrite(f);
Close(f);
end;
{ otvorime subor pre spocitanie ziakov }
por:=1;
Assign(f,cesta+ZIAK_ZOZ);
ReSet(f);
{ spocitame pocet ziakov }
while( not(eof(f))) do begin
ReadLn(f,pom);
por:=por+1;
end;
Close(f);
{ na koniec pripoji noveho ziaka }
Append(f);
Write(f,por,' ');
WriteLn(f,s);
Close(f);
{ ma taketo poradove cislo }
NovyZiak:=por;
end;
{ z cisel 1,2,3,4 urobi moznosti a,b,c,d }
function Moznost(i:byte):string;
begin
Moznost:=chr(i+ ord('a') -1) +') ';
end;
{ na obrazovku vypise bud zadanie, alebo moznosti }
procedure NaObr(je_odp:boolean;s:string);
var dlz:integer;
pom:string;
begin
while (Length(s)>0) do begin
pom:=DivPos(s);
dlz:=Length(pom);
{ este sa vojde do riadku ? }
if( px+dlz>65 ) then begin
py:=py+1;
px:=1;
{ ak to bude a,b,c,d zarovna az zane }
if( je_odp )then px:=4;
end;
{ na monitor vypise otazku cislo por }
{ tu ktoru urcil ziak oznaci cervenou, spravnu zelenou }
function NapisOtazku(por:integer;dobre,zle:byte):string;
var f:text;
s:string;
poc,i:integer;
moz:array[1..4] of string;
begin
Assign(f,cesta+test);
Reset(f);
{ default }
NapisOtazku:='';
px:=1; py:=1;
i:=0;
{ najdeme zaciatok otazky }
while(i<por) do begin
ReadLn(f,s);
if(s='+')then i:=i+1;
end;
{ precitame text zadania otazky }
farba(blue,yellow);
ReadLn(f,s);
while(s<>'-') do begin
NaObr(false,s);
ReadLn(f,s);
end;
poc:=0; py:=py+1;
ReadLn(f,s);
{ precitame otazky }
while (s<>'+') do begin
poc:=poc+1;
{ kolko bodov ma tato odpoved }
odp[poc]:=ToInt(DivPos(s));
{ ulozime si tuto moznost }
moz[poc]:=s;
{ citaj dalsiu odpoved }
ReadLn(f,s);
end;
{ bud vsetky moznosti vypiseme }
{ alebo to bude 1 moznost a potom nepiseme nic }
if( poc>1 )then
for i:=1 to poc do begin
{ akou farbou to vypisem, je to dobra/zla odpoved }
farba(black,lightgray);
if (i=zle) then farba(red, lightgray);
if (i=dobre) then farba(green, lightgray);
px:=1; py:=py+1;
NaObr(true,Moznost(i)+moz[i]);
end
else
begin
NapisOtazku:=moz[1];
odp[2]:=0;
end;
farba(black,lightgray);
Close(f);
end;
{ caka odpoved a,b,c,d alebo konkretny text? }
{ zarovan bude pocitat aj body }
function Odpoved(s:string;var body:integer):string;
var por:integer;
sodp:string;
begin
{ caka a,b,c,d }
if(s='')then
begin
repeat
o:=readkey;
until (o in ['a'..'d','A'..'D']);
{ pripocita body ak neake su }
por:=ord(UpCase(o))-ord('A')+1;
body:=body+odp[por];
sodp:=ToStr(por);
end
else
{ caka text odpovede }
begin
px:=1; py:=py+1;
NaObr(true,'Odpoved:');
ReadLn(sodp);
{ vsetko dame velkym }
if( SUpCase(s)=SUpCase(sodp)) then
body:=body+odp[1];
end;
Odpoved:=sodp;
end;
{ zacne testovanie ziakov }
procedure Testuj;
var f:text;
i,por:integer;
body:integer;
s,sodp:string;
o:char;
begin
Uvod(2,0,0,0);
writexy(10,6,'Zadaj svoje meno: ');
Readln(meno);
{ zapise do zoznamu studentov a dostane cislo }
por:=NovyZiak(meno);
body:=0;
{ otvori subor pre zapis }
Assign(f, cesta+ToStr(por)+TST_KON);
ReWrite(f);
WriteLn(f,meno);
{ kladie otazky od 1 do n }
for i:=1 to po do begin
{ vypise aky je stav }
Uvod(1,i,body,0);
{ napise otazku a pocka na odpoved }
s:=NapisOtazku(i,0,0);
sodp:=Odpoved(s,body);
{ zapise do suboru cislo otazky a odpoved }
WriteLn(f,i,' ',sodp);
end;
{ najde najvacsie bodove ohodnotenie }
function NajdiOdpoved:integer;
var max,i,imax:integer;
begin
imax:=1;
max:=odp[imax];
for i:=2 to 4 do
if(odp[i]>max) then begin
max:=odp[i];
imax:=i;
end;
NajdiOdpoved:=imax;
end;
{ vyberie si ziaka z poradovnika }
function VyberZiaka:integer;
var f:text;
por,zac:integer;
spolu:integer;
koniec:boolean;
ch:char;
i,x:integer;
s:string;
begin
Assign(f,cesta+ZIAK_ZOZ);
ReSet(f);
{ zisti cislo posledneho ziaka }
while (not(eof(f))) do
ReadLn(f,spolu,meno);
zac:=0; por:=1;
koniec:=false;
repeat
Close(f);
Reset(f);
{ precitam az po zaciatok }
i:=0;
Uvod(2,0,0,0);
for x:=1 to zac do ReadLn(f,i,s);
while (not(eof(f)) and (i<(zac+10))) do begin
ReadLn(f,i,s);
WriteXY(11,6+i-zac,ToStr(i) +'.' +s);
end;
WriteXY(10,22,'Stlac 0 az 9 pre vyber ziaka. o-stranka vpred, p-stranka vzad');
ch:=ReadKey;
{ vybral si od 1..9 }
if(ch in ['1'..'9','0']) then begin
por:=zac+Ord(ch)-Ord('1')+1;
koniec:=true;
end;
{ vybral si 0 tam musim pripocitat 10 }
if(ch='0') then por:=zac+10;
{ chce sa presunut o stranku o-vpred, p-vzad }
if(ch='o') and (zac>0) then zac:=zac-10;
if(ch='p') and ((zac+10)<spolu) then zac:=zac+10;
until (koniec);
VyberZiaka:=por;
end;
{ zobrazi vysledky testovania ziakov }
procedure Vysledky;
var f:text;
por,i:integer;
body:integer;
o,dobre:integer;
s,sodp:string;
begin
{ najprv vyberie ziaka zo zoznamu }
por:=VyberZiaka;
Assign(f, cesta+ToStr(por)+TST_KON);
Reset(f);
{ precita meno ziaka }
ReadLn(f,meno);
{ precita body/znamku }
while not(eof(f)) do ReadLn(f,body);
{ znova na zaciatok suboru }
Close(f);
Reset(f);
ReadLn(f,meno);
for i:=1 to po do
begin
{ precita odpoved na otazku }
Read(f,o); Read(f,s);
while(s[1]=' ') do Delete(s,1,1);
sodp:=NapisOtazku(i,1,1);
dobre:=NajdiOdpoved;
if (sodp='') then begin
o:=ToInt(s);
Uvod(3,i,odp[o],body);
NapisOtazku(i,dobre,o);
end
else
begin
if( SUpCase(s)=SUpCase(sodp))then o:=1
else o:=2;
Uvod(3,i,odp[o],body);
NapisOtazku(i,1,1);
{ ak bola zla odpoved }
if(o=2)then begin
farba(red,lightgray);
px:=1; py:=py+1;
NaObr(true,'Odpoved: '+s);
end;
{ povodna farba }
farba(black,lightgray);
end;
Pause;
end;
{ zavrieme subor }
Close(f);
end;
{ zisti ako sa vola test ak nezada nic tak default }
function DajMenoTestu:string;
begin
if(ParamCount>0) then
DajMenoTestu:=ParamStr(1)
else
DajMenoTestu:=TST_MENO;
end;
BEGIN
cesta:=DajCestu;
test:=DajMenoTestu;
AnalyzeTest;
repeat
Uvod(0,0,0,0);
o:=readkey; { pocka na stlacenie 1,2,3 }