Umiestnenie súboru www.TrSek.com/cover/lizal_okurek/bingo.pas{ BINGO.PAS Copyright (c) Jiri Grummich }
{ Program simuluje hru Bingo }
{ Muzes sazet na sloupce,radky,cisla a barvu(suda,licha) }
{ Sloupce: ùsloupec Xù X nabyva hodnot A,B,C }
{ Radky: ùrada Xù X nabyva hodnot 1 az 10 }
{ Cislo: ùcisloù a pote na dotaz zadej cislo }
{ Barva: ùsudeù nebo ùlicheù }
{ }
{ Datum:31.03.2003 http://www.trsek.com }
Program BINGO;
uses crt;
var A,S,SA,SB,SC,R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,SUD,LICH,K,KS,A2,F,H,x,y,je,meza,bekl,K2,KS2,W,CHEAT : integer;
B,Z,UG,JCH : string;
VL : char;
Begin
repeat
textbackground (white);
clrscr;
textcolor (56);
writeln (' RULETA ');
writeln;
writeln;
textcolor (RED);
writeln ('1.........HRAT');
writeln ('2.........PRAVIDLA HRY');
writeln ('3.........KONEC');
writeln;
writeln;
writeln;
writeln;
textcolor (green);
writeln (' Jiri Grummich ');
VL := readkey;
if VL = '2' then begin
clrscr;
textcolor (56);
writeln (' PRAVIDLA HRY ');
writeln;
writeln;
textcolor (white);
writeln ('-Zacinas s 5000Kc v penezence (BANK).');
writeln ('-Muzes sazet na sloupce,radky,cisla a barvu(suda,licha)');
writeln ('-Sloupce: ùsloupec Xù X nabyva hodnot A,B,C');
writeln ('-Radky: ùrada Xù X nabyva hodnot 1 az 10');
writeln ('-Cislo: ùcisloù a pote na dotaz zadej cislo');
writeln ('-Barva: ùsudeù nebo ùlicheù');
writeln ('-Sazky ukoncis napises-li na dotaz: ùChcete vsadit?ù ùneù');
writeln ('-Nemuzete vsadit zapornou sazku ani se zadluzit v banku!');
writeln ('-Z programu vyjedes jestlize na otazku ùChcete vsadit?ù odpovis ùkonecù');
writeln ('-Je-li tvuj bank nad 10000Kc vyhral jsi!');
writeln ('-Je-li tvuj bank pod 500Kc prohral jsi!');
writeln ('-Kurzy:');
writeln ('- Barva: 0.2x');
writeln ('- Sloupec: 0.3x');
writeln ('- Rada: 1x');
writeln ('- Cislo: 4x');
writeln ('- Cislo 0: 10x');
writeln ('-Program vytvoril Jiri Grummich');
Jch:=readkey;
if JCH = '0' then begin
writeln;
writeln;
writeln;
textcolor (89);
writeln ('Cheaty: Piste na otazku ùChcete vsadit?ù.');
writeln (' - ùnavalprachytyjedenzkurvenejcurakuù - prida 1000Kc do banku');
writeln (' - ùbozedejmicisloù (u posledni sazky) a pak zadejte cislo.');
readkey;
end;
end;
if VL = '1' then begin
A:=5000;
A2:=A;
repeat
R1:=0;
R2:=0;
R3:=0;
R4:=0;
R5:=0;
R6:=0;
R7:=0;
R8:=0;
R9:=0;
R10:=0;
SUD:=0;
LICH:=0;
SA:=0;
SB:=0;
SC:=0;
KS:=0;
KS2:=0;
x:=0;
Y:=0;
MEZA:=0;
textcolor (red);
textbackground (black);
clrscr;
K:=31;
write (chr (201),chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
write (chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
write (chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
write (chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
write (chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
writeln (chr (187));
writeln (chr (186),' A B C ',chr (186));
write (chr (204),chr (205),chr (205),chr (205),chr (205),chr (205));
write (chr (205),chr (205),chr (205),chr (205),chr (203),chr (205));
write (chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
write (chr (205),chr (205),chr (205),chr (203),chr (205),chr (205));
write (chr (205),chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
writeln (chr (185));
writeln (chr (186),' 1',chr (186),' 01 02 03 ',chr (186),'1 ',chr (186));
writeln (chr (186),' S 2',chr (186),' 04 05 06 ',chr (186),'2 L ',chr (186));
writeln (chr (186),' 3',chr (186),' 07 08 09 ',chr (186),'3 ',chr (186));
writeln (chr (186),' U 4',chr (186),' 10 11 12 ',chr (186),'4 I ',chr (186));
writeln (chr (186),' 5',chr (186),' 13 14 15 ',chr (186),'5 ',chr (186));
writeln (chr (186),' 6',chr (186),' 16 17 18 ',chr (186),'6 C ',chr (186));
writeln (chr (186),' 7',chr (186),' 19 20 21 ',chr (186),'7 ',chr (186));
writeln (chr (186),' D 8',chr (186),' 22 23 24 ',chr (186),'8 H ',chr (186));
writeln (chr (186),' 9',chr (186),' 25 26 27 ',chr (186),'9 ',chr (186));
writeln (chr (186),' A 10',chr (186),' 28 29 30 ',chr (186),'10 A ',chr (186));
writeln (chr (186),' ',chr (186),' 00 ',chr (186),' ',chr (186));
write (chr (200),chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
write (chr (205),chr (205),chr (205),chr (202),chr (205),chr (205),chr (205));
write (chr (205),chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
write (chr (202),chr (205),chr (205),chr (205),chr (205),chr (205),chr (205));
writeln (chr (205),chr (205),chr (205),chr (188));
writeln;
textcolor (white); {vkladni cast}
repeat
writeln ('Vas bank je: ',A2,' Kc.');
writeln ('Chcete vsadit? ');
readln (Z);
if (Z<>'ne') and (Z<>'konec') then begin
if (Z='navalprachytyjedenzkurvenejcuraku') then A2:=A2+1000;
if (Z='bozedejmicislo') then begin
readln (H);
cheat:=2;
end
else cheat:=1;
repeat
write ('Napiste castku pro vklad: ');
readln (S); {nacte sazku}
A2:=A2-S; {pripad prohry}
if (A2 <= 0) or (S<=0) then begin
writeln ('Zadali jste zapornou sazku!!');
A2:=A2+S+1;
S:=0;
end;
until S > 0;
write ('Na co sazet? ');
read (B); {nacte kam umistit sazku}
if B='sloupec A' then SA:=trunc (S*1.3); {urceni sloupcu}
if B='sloupec B' then SB:=trunc (S*1.3);
if B='sloupec C' then SC:=trunc (S*1.3); {urceni sloupcu}
if B='rada 1' then R1:=S*2; {urceni rad}
if B='rada 2' then R2:=S*2;
if B='rada 3' then R3:=S*2;
if B='rada 4' then R4:=S*2;
if B='rada 5' then R5:=S*2;
if B='rada 6' then R6:=S*2;
if B='rada 7' then R7:=S*2;
if B='rada 8' then R8:=S*2;
if B='rada 9' then R9:=S*2;
if B='rada 10' then R10:=S*2; {urceni rad}
if B='suda' then SUD:=trunc (S*1.2); {urceni sudych}
if B='licha' then LICH:=trunc (S*1.2); {urceni lichych}
if B='cislo' then begin {urceni cisla}
writeln ('Napis cislo: ');
if K = 31 then begin
read (K);
if K=0 then KS:=S*10
else KS:=S*4;
end
else begin
read (K2);
if K2=0 then KS2:=S*10
else KS2:=S*4
end
end; {urceni cisla}
readln;
end;
until (Z='ne') or (Z='konec');
{2. cast}
textbackground (blue); {graf. cast}
clrscr;
gotoxy (1,1);
write (chr (220));
if CHEAT = 1 then begin
randomize;
H:=random (30);
end;
repeat
delay (50);
x:=x+1;
gotoxy (x,y);
write (chr (220));
until x=60;
gotoxy (40,3);
textcolor (45);
write ('!S A Z K Y J S O U U Z A V R E N Y!');
gotoxy (30,10);
textcolor (12); {graf. cast}
write ('Vyhrava cislo '); {inicializace vyherniho cisla}
delay (100);
writeln (H);
writeln ('Vyhrava: ');
delay (920);
if H mod 2 = 0 then begin
writeln (' Sude cislo');
MEZA:=MEZA+SUD;
end
else begin
writeln (' Liche cislo');
MEZA:=MEZA+LICH;
end;
delay (920);
if H mod 3 = 0 then begin
writeln (' 3. sloupec');
MEZA:=MEZA+SC;
end
else if (H+2) mod 3 = 0 then begin
writeln (' 1. sloupec');
MEZA:=MEZA+SA;
end
else begin
writeln (' 2. sloupec');
MEZA:=MEZA+SB;
end;
delay (920);
if H mod 3 = 0 then begin
JE:=H div 3;
writeln (' ',JE,'. rada');
end
else begin
JE:=(H div 3) + 1;
writeln (' ',JE,'. rada');
end; {inicializace vyherniho cisla}
if JE = 1 then MEZA:=MEZA+R1;
if JE = 2 then MEZA:=MEZA+R2;
if JE = 3 then MEZA:=MEZA+R3;
if JE = 4 then MEZA:=MEZA+R4;
if JE = 5 then MEZA:=MEZA+R5;
if JE = 6 then MEZA:=MEZA+R6;
if JE = 7 then MEZA:=MEZA+R7;
if JE = 8 then MEZA:=MEZA+R8;
if JE = 10 then MEZA:=MEZA+R10;
if H = K then MEZA:=MEZA+KS;
if H = K2 then MEZA:=MEZA+KS2;
delay (920);
writeln;
writeln;
textcolor (red);
if MEZA<>0 then writeln (' Vyhral jste ',MEZA,' Kc!!')
else writeln (' Bohuzel, nic jste nevyhral.');
textcolor (yellow);
write ('Vas aktualni bank je: ');
delay (600);
A2:=A2+MEZA;
textcolor (black);
write (A2,'Kc!');
readkey;
if A2 > 10000 then W:=1;
if A2 < 500 then W:=2;
until (A2 <= 500) or (Z = 'konec') or (A2 > 10000);
if W = 1 then begin
clrscr;
textbackground (Blue);
gotoxy (10,15);
textcolor (68);
write ('V y h r a l j s t e ! ! ! ! ');
readkey;
end;
if W = 2 then begin
clrscr;
textbackground (Blue);
gotoxy (10,15);
textcolor (68);
write ('Z b a n k r o t o v a l j s t e ! ! ! ! ! ');
readkey;
end;
if W = 0 then begin
clrscr;
textbackground (Blue);
gotoxy (10,15);
textcolor (68);
write (' V z d a l j s i t o s r a c k o ! ! ! ');
readkey;
end;
end;
if VL = '3' then clrscr;
until VL = '3';
End.