Lotéria. Po zadaní piatich čísel začne náhodne generovanie s tým, že napíše koľko typov ste mali správne.

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Category: KMP (Club of young programmers)

Author: Mišo Bukový
Program: Bx_lotery.pas
File exe: Bx_lotery.exe

Lotéria. Po zadaní piatich čísel začne náhodne generovanie s tým, že napíše koľko typov ste mali správne.
{ BX_LOTERY.PAS                           Copyright (c) Miso Bukovy }
{ Loteria.                                                          }
{ Po zadani piatich cisel zacne nahodne generovanie s tym ze napise }
{ kolko typov ste mali spravne. Pozor! Hra sa o zaujimave ceny...   }
{                                                                   }
{ Datum:29.12.2009                             http://www.trsek.com }
 
uses crt,dos;
var x,y:byte;
    k,l,m,n,o:integer;
    i,a:integer;
    sucet,sucet1,sucet2,sucet3,sucet4,sucet5:integer;
 
 
procedure hide;
var reg:registers;
begin
     reg.ah:=1;
     reg.ch:=32;
     intr($10,reg);
end;
 
{Typovanie}
procedure typ;
 
begin
     writeln('Losuje sa z cisel od 0 po 9 tagze nieze zadas 15 ;)');
     write('Zadaj 1. cislo: ');
     readln(k);
     write('Zadaj 2. cislo: ');
     readln(l);
     write('Zadaj 3. cislo: ');
     readln(m);
     write('Zadaj 4. cislo: ');
     readln(n);
     write('Zadaj 5. cislo: ');
     readln(o);
end;
 
{Zrebovanie}
 
procedure zreb;
var i,a:integer;
 
begin
     randomize;
     for i:=1 to 10 do begin
                        a:=random(9);
                        delay(200);
                        gotoxy(x,y);
                        write(a);
                       end;
     gotoxy(2,20);
     writeln('Pre dalsie cislo stlac Enter');
end;
 
 
 
begin
     hide;
     repeat
     clrscr;
     writeln('Vitajte v BX losovani. Vyhrat mozte krasne ceny: aaa');
     writeln;
     writeln('5-4 spravnych typov: Notebook (IntelCore2Duo 200Mhz,GeForce800GX2,640KB RAM');
     writeln('3-2 spravne typy: USB kluc 1,44MB');
     writeln('1 spravna odpoved: Figa borova 120TB (pripojenie cez serial-ATA, alebo USB 1,1)');
     writeln;
     writeln('Hrat zacnes stlacenim ENTERu');
     writeln('Ak hrat nechces stlac ESC');
     if(readkey=#27) then halt;
     clrscr;
     typ;
     clrscr;
 
     x:=2; y:=1;
      for i:=1 to 10 do begin
                        a:=random(9);
                        delay(200);
                        gotoxy(x,y);
                        write(a);
                         if(a=k) or(a=l) or(a=m) or(a=n) or(a=o)
                                  then begin
                                        write(' ...dobre!              ');
                                        sucet1:=1;
                                       end;
                         if (a<>k) and(a<>l)and(a<>m)and(a<>n)and(a<>o)
                                   then begin
                                         write(' ...zle!               ');
                                         sucet1:=0;
                                        end;
 
                       end;
 
 
     x:=2; y:=3;
      for i:=1 to 10 do begin
                        a:=random(9);
                        delay(200);
                        gotoxy(x,y);
                        write(a);
                         if (a=k) or(a=l) or(a=m) or(a=n) or(a=o)
                                  then begin
                                        write(' ...dobre!                  ');
                                        sucet2:=1;
                                       end;
                         if (a<>k) and(a<>l)and(a<>m)and(a<>n)and(a<>o)
                                   then begin
                                         write(' ...zle!                   ');
                                         sucet2:=0;
                                        end;
                       end;
 
 
     x:=2; y:=5;
      for i:=1 to 10 do begin
                        a:=random(9);
                        delay(200);
                        gotoxy(x,y);
                        write(a);
                         if (a=k) or(a=l) or(a=m) or(a=n) or(a=o)
                                  then begin
                                        write(' ...dobre!                  ');
                                        sucet3:=1;
                                       end;
                         if (a<>k) and(a<>l)and(a<>m)and(a<>n)and(a<>o)
                                  then begin
                                         write(' ...zle!                   ');
                                         sucet3:=0;
                                        end;
                       end;
 
 
 
     x:=2; y:=7;
      for i:=1 to 10 do begin
                        a:=random(9);
                        delay(200);
                        gotoxy(x,y);
                        write(a);
                         if (a=k) or(a=l) or(a=m) or(a=n) or(a=o)
                                  then begin
                                        write(' ...dobre!                       ');
                                        sucet4:=1;
                                       end;
                         if (a<>k) and(a<>l)and(a<>m)and(a<>n)and(a<>o)
                                   then begin
                                         write(' ...zle!                        ');
                                         sucet4:=0;
                                        end
                       end;
 
 
 
     x:=2; y:=9;
      for i:=1 to 10 do begin
                        a:=random(9);
                        delay(200);
                        gotoxy(x,y);
                        write(a);
                         if (a=k) or(a=l) or(a=m) or(a=n) or(a=o)
                                  then begin
                                        write(' ...dobre!                  ');
                                        sucet5:=1;
                                       end;
                         if (a<>k) and(a<>l)and(a<>m)and(a<>n)and(a<>o)
                                   then begin
                                         write(' ...zle!                   ');
                                         sucet5:=0;
                                        end
                       end;
 
     {vyhodnotenie programu}
     gotoxy(37,5);
     sucet:=sucet1+sucet2+sucet3+sucet4+sucet5;
     textcolor(red);
      if (sucet=0) then begin
                             gotoxy(28,5);
                             writeln('Je mi luto, ale nevisiel ti ani jeden typ');
                             gotoxy(18,6);
                             writeln('Dostanes toaletny papier ako darcek od nasho sponzora :)');
                        end;
      if (sucet=1) then begin
                             writeln('Vysiel ti 1 typ');
                             gotoxy(35,6);
                             writeln('Vyhravas Figu borovu!');
                        end;
      if (sucet=2) or (sucet=3) then begin
                                          writeln('Vysli ti ',sucet,' typy');
                                          gotoxy(35,6);
                                          writeln('Vyhravas USB kluc 1,44MB');
                                     end;
      if (sucet=4) then begin
                             writeln('Vysli ti 4 typy');
                             gotoxy(35,6);
                             writeln('Vyhravas Notebook');
                        end;
      if (sucet=5) then begin
                             writeln('Vysli ti vsetky typy :)');
                             gotoxy(35,6);
                             writeln('Vyhravas Notebook');
                        end;
     gotoxy(45,7);
     write(' ');
     gotoxy(30,8);
     write('Cenu si mozes vyzdvihnut v Hnusti na namesti');
     gotoxy(30,9);
     write('presne o 14:00 29.2.2009.');
     textcolor(white);
     gotoxy(35,20);
     writeln('Pre koniec stlac Esc');
    { gotoxy(35,21);
     writeln('Tento program ma prosimpekne 201 riadkov :)');}
     gotoxy(1,22);
     writeln('Made by BX');
     gotoxy(1,23);
     writeln('Pripadne chyby, alebo vylepsenia programu odoslite na BXcorp@zoznam.sk');
     until (readkey=#27);
end.