{ MILION.PAS Copyright (c) TrSek alias Zdeno Sekerak } { Program napodobnuje hru milionar. } { Jednotlive otazky sa definuju v textovych suboroch. } { } { Datum:19.01.2005 http://www.trsek.com } program hra_milionar; uses crt,dos,graph,mycrt; const MENA='milion.txt'; peniaze:array[1..10] of integer= (5,10,15,50,75,100,150,300,500,1000); var grDriver:Integer; grMode:Integer; q:char; { stlaceny klaves } { kolko to je korun ma level } function cena(level:integer):string; begin if(level=0)then cena:='0' else cena:=Cislo(peniaze[level],4)+' 000'; end; { vykresli graf vysledkov } procedure vysledky; var meno:string; level:integer; f:text; i:integer; begin grDriver := Detect; InitGraph(grDriver, grMode,' '); outtextxy(140,5,'Vysledkova listina jednotlivych hracov'); { nakreslime os } line(80,18,80,450); { nastavime vzor vyplnovania } SetFillStyle(SolidFill, Green); { zacneme citat subor } assign(f,MENA); reset(f); i:=0; { vycitame vsetkych sutaziacich, ale maximalne 24 } while(not(eof(f)) and (i<24))do begin inc(i); readln(f,meno); readln(f,level); { meno hraca } outtextxy(5,i*18+6,meno); { jeho score } bar3d(80,i*18,80+level*55,(i+1)*18,0,TopOff); outtextxy(level*55+10,i*18+6,Cena(level)); end; { zatvorime subor } close(f); { vypiseme spravu } outtextxy(140,465,'Pre navrat do menu stlac klaves '); readln; { zatvoriem grafiku } CloseGraph; end; { vyberie zo suboru jednu otazku a tu vypise } function VypisOtazku(level:integer):integer; var f:text; otazka:string; odp:array[1..4] of string; por:array[1..4] of integer; x,i:integer; begin { otvorime subor } assign(f,'level.'+ Cislo(level,0)); reset(f); { nahodne vygeneruje otazku od 1-3 } x:=trunc(random(3)); { precita subor az po otazku } for i:=1 to (x*6)+1 do readln(f,otazka); { vyprazdni pole poradi otazok } for i:=1 to 4 do por[i]:=0; { zamiesa odpovede } for i:=1 to 4 do begin x:=trunc(random(4))+1; { najde dalsieho vhodneho kandidata } while(por[x]<>0) do begin if(por[x]<>0)then x:=x+1; if(x>4)then x:=1; end; { nasiel } por[x]:=i end; { precita mozne odpovede } readln(f,odp[por[1]]); readln(f,odp[por[2]]); readln(f,odp[por[3]]); readln(f,odp[por[4]]); { zatvorime subor } close(f); { vypiseme otazku } writexy(10,10,otazka); { vypiseme odpovede } writexy(12,12,'a. '+ odp[1]); writexy(12,13,'b. '+ odp[2]); writexy(12,14,'c. '+ odp[3]); writexy(12,15,'d. '+ odp[4]); writexy(10,17,'Stlac a,b,c,d'); { prva odpoved v subore je vzdy spravna } VypisOtazku:=por[1]; end; { vyopise ake je skore } procedure VypisScore(level:integer); var i:integer; begin writexy(60,6,' Peniaze'); writexy(60,7,'--------'); for i:=1 to 10 do begin if(i=level)then farba(red,yellow) else farba(black,yellow); writexy(60,18-i,Cena(i)); end; farba(black,yellow); end; { hra milionar } procedure milionar; var odp:integer; ch:char; level:integer; konc:boolean; meno:string; begin randomize; level:=0; konc:=false; { opytame sa ako sa vola } clrscr; write('Zadaj svoje meno:'); readln(meno); repeat clrscr; writexy(30,2,'VEDOMOSTNY KVIZ'); writexy(30,4,'hrac:'+meno); VypisScore(level); odp:=VypisOtazku(level+1); { cakaj na klaves } ch:=readkey; { klavesa ESC konci } if(ch=#27)then konc:=true; { neuhadol - konci, uhadol - dalsi level } if((ord(ch)-ord('a'))<>(odp-1))then begin konc:=true; writexy(10,17,'Zle spravna odpoved je: '+chr(odp+96)); end else begin inc(level); { dalsi level } VypisScore(level); { vypis skore } end; { ak uhadol aj poslednu otazku konci } if(level=10)then konc:=true; until (konc); { skore zapiseme do suboru } Zapis(MENA,meno,level); { este ho nechame nech si to pozrie } writexy(10,18,'Vyhral si:'+cena(level)+' Sk'); writexy(10,20,'Pre navrat do menu stlac klaves '); ch:=readkey; end; { zaciatok programu } BEGIN repeat clrscr; farba(black,red); writexy(26,10,'Ponuka cinnosti:'); writexy(26,11,'1. Hra Milionar'); writexy(26,12,'2. Prezriet vysledky'); writexy(26,13,'3. Koniec'); q:=readkey; { precita stlaceni eklavesu } if(q='1') then milionar; { spusti hru } if(q='2') then vysledky; { ukaze vysledky } until(q='3'); { q=3 koniec } END.