{ 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+} if(IOResult<>0)then JeSubor:=false else JeSubor:=true; end; { 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 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; Assign(f,cesta+test); Reset(f); { meno testu } ReadLn(f,mt1); ReadLn(f,mt2); { znamky } ReadLn(f,i,znam[1,1],znam[1,2]); ReadLn(f,i,znam[2,1],znam[2,2]); ReadLn(f,i,znam[3,1],znam[3,2]); ReadLn(f,i,znam[4,1],znam[4,2]); ReadLn(f,i,znam[5,1],znam[5,2]); { znulujeme } po:=0; pb:=0; max:=0; odpoved:=false; { 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; writexy(10+px,10+py,pom+' '); px:=px+dlz+1; end; 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'-') 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; { zapiseme body/znamku zavrie subor } WriteLn(f,body); Close(f); { oznamkuj ho } Uvod(4,po,body,pb); Pause; 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)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 } if(o='1')then Testuj; if(o='2')then Vysledky; until(o='3'); Clrscr; END.