| |
Turbo Pascal Twoje źródło wiedzy o Turbo Pascalu. |
|
|
|
|
|
 |
Wto 14:56, 28 Mar 2006 |
 |
 Autor |
Wiadomość |
rafael
Administrator
Dołączył: 07 Lut 2006
Posty: 72
Przeczytał: 0 tematów
Ostrzeżeń: 0/3
Skąd: Pszczyna
|
| Temat postu: Lotto |
|
|
PROGRAM NAŚLADUJE GRĘ LICZBOWĄ DUŻY LOTEK. UŻYTKOWNIK SAM DECYDUJE, CZY WPROWADZA WŁASNE LICZBY, CZ GRA METODĄ "CHYBIŁ TRAFIŁ"; MOŻE KTOŚ WYGRA MILION ? :wink:
| Kod: | program lotto;
{$APPTYPE CONSOLE}
uses
crt;
type
Ttab = array[1..6] of byte;
label
poczatek;
procedure wylosowywuj (liczba: Ttab); forward;
procedure sprawdz(kula, liczba: Ttab); forward;
procedure wypisz(kula, liczba: Ttab; odgadniete:byte); forward;
procedure wprowadz(wybor: boolean); forward;
procedure logo;
begin
textcolor(white);
gotoxy(30,1);
writeln('*************************');
gotoxy(30,2);
writeln('** LOTTO 1.0 **');
gotoxy(30,3);
writeln('** COPYRIGHT BY RAFAEL **');
gotoxy(30,4);
writeln('*************************');
end;
procedure menu;
var
znak: char;
x: byte;
wybor: boolean;
begin
x := 1;
repeat
if znak = #80 then x := x + 1;
if znak = #72 then x := x - 1;
if x = 4 then x := 1;
if x = 0 then x := 3;
if x = 1 then
textcolor(yellow)
else
textcolor(white);
gotoxy(36,10);
writeln('Wlasne typy');
if x = 2 then
textcolor(yellow)
else
textcolor(white);
gotoxy(35,11);
writeln('Chybil trafil');
if x = 3 then
textcolor(yellow)
else
textcolor(white);
gotoxy(38,12);
writeln('Wyjscie');
znak := readkey;
until znak = #13;
if x = 1 then wprowadz(true);
if x = 2 then wprowadz(false);
if x = 3 then halt;
end;
function losuj: integer;
begin
randomize;
losuj := random(49)+1;
end;
procedure wprowadz(wybor: boolean);
var
i,x: byte;
liczba: Ttab;
liczb: byte;
begin
if wybor = true then
begin
for i := 1 to 6 do
begin
repeat
x := i;
clrscr;
write('Wprowadz szesc roznych liczb (1-49): ');
readln(liczba[i]);
for x := x-1 downto 1 do
if liczba[i] = liczba[x] then
begin
liczb := liczba[i];;
repeat
gotoxy(1,2);
write('Ta liczba juz byla! Wprowadz inna: ');
readln(liczba[i]);
clreol;
until liczb <> liczba[i];
end;
if (liczba[i] < 1) or (liczba[i] > 49) then
begin
gotoxy(1,2);
writeln(#7,'Ta liczba wykracza poza zakres 1 - 49!!!');
delay(2000);
end;
until (liczba[i] > 0) and (liczba[i] < 49);
end;
end;
if wybor = false then
begin
for i := 1 to 6 do
begin
for x := 1 to 6 do
if liczba[i] = liczba[x] then
begin
liczb := liczba[i];
repeat
liczba[i] := losuj;
until liczba[i] <> liczb;
end;
liczba[i] := losuj;
end;
end;
clrscr;
wylosowywuj(liczba);
end;
procedure wylosowywuj (liczba: Ttab);
var
kula: Ttab;
i,x: byte;
liczb: byte;
begin
for i := 1 to 6 do
begin
for x := 1 to 6 do
if kula[i] = kula[x] then
begin
liczb := kula[i];
repeat
kula[i] := losuj;
until kula[i] <> liczb;
end;
kula[i] := losuj;
end;
sprawdz(kula,liczba);
end;
procedure sprawdz(kula, liczba: Ttab);
var
i, x: byte;
odgadniete: byte;
begin
odgadniete := 0;
for i := 1 to 6 do
begin
for x := 1 to 6 do
begin
if kula[i] = liczba[x] then odgadniete := odgadniete + 1;
end;
end;
wypisz(kula,liczba,odgadniete);
end;
procedure wypisz(kula, liczba: Ttab; odgadniete:byte);
var
i: byte;
begin
write('Twoje liczby: ');
for i := 1 to 6 do
write(liczba[i],'; ');
writeln;
write('Wylosowane liczby: ');
for i := 1 to 6 do
write(kula[i],'; ');
writeln;
writeln('Wspolne: ',odgadniete);
writeln;
if odgadniete < 3 then
writeln('Niestety nic nie wygrales!!!');
if odgadniete = 3 then
writeln('Wygrales 10 zlotych!!!');
if odgadniete = 4 then
writeln('Wygrales 125 zlotych!!!');
if odgadniete = 5 then
writeln('Wygrales ok. 5 000 zlotych!!!');
if odgadniete = 6 then
writeln('Wygrales ok. 1 000 000 zlotych!!!');
readln;
end;
procedure koniec;
var
zakoncz: char;
begin
repeat
clrscr;
gotoxy(27,10);
write('Jeszcze raz?? (T)ak / (N)ie: ');
zakoncz := readkey;
until zakoncz in ['T','t','N','n'];
if zakoncz in ['N','n'] then halt;
end;
begin
poczatek:
clrscr;
logo;
menu;
koniec;
goto poczatek;
end. |
:arrow: Plik exe :wink: [link widoczny dla zalogowanych]
Post został pochwalony 0 razy
|
|
| |
|
|
|
|
|
 |
  |
|
 |
|
|
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
|
|
|
|
|
|
|
fora.pl - załóż własne forum dyskusyjne za darmo
Powered by phpBB © 2001, 2002 phpBB Group
|
|
|
|
|
|
|
|
| |
|
|
|
|
|
|
Kody źródłowe 
