Question

Potrzebuje program lotto w Pascalu

Answer 1

Oto program, który losuje 6 z 49 liczb:
Jeżeli chcesz to zmienić wystarczy zmienić stałe, ilość to liczba losowanych elementów, a zakres to największa liczba z tych z których losujemy

program lotto;
const zakres = 49;
-------ilosc = 6;
var tab: array [1..ilosc] of integer;
-----i, j, liczba: integer;
-----byla: boolean;

begin
-------randomize;

-------for i := 1 to ilosc do
-------begin
--------------byla := true;

--------------while byla do
--------------begin
---------------------liczba := random(zakres);
---------------------byla := false;

---------------------for j := 1 to i - 1 do
---------------------begin
----------------------------if tab [j] = liczba then byla := true;
---------------------end;
--------------end;

--------------writeln (i, '. wylosowana liczba to ', liczba);
--------------tab [i] := liczba;
-------end;
-------readln;
end.

znaki "-------" nienależną do kodu, tylko poprawiają czytelność zapisu (niestety nadmiar spacji jest automatycznie usuwany
jak masz pytania to pisz na pw

Answer 2

W tym programie podajesz liczbę kulek np 45; i ile ma wybrać np6 pokazuje wszystkie możliwe kombinacje
program lotto;
const
max_elem=100;
type
tablica=array [1..max_elem] of integer;
var
n:integer;
k:integer;
tab:tablica;
tak_nie:char;
procedure wyswietlanie (k:integer);
var
nr_elementu: integer;
begin
for nr_elementu:=1 to k do
write (tab [nr_elementu]:4);
writeln;
end;
procedure kombinacje (a,b:integer);
var
element:integer;
begin
for element:=b to n-k+a do
begin
tab[a]:=element;
if a<k then
kombinacje (a+1, element+1)
else
wyswietlanie (k)
end;
end;
begin
while n<=k do
begin
writeln('wyznacz kombinacje n po k');
writeln;
write('podaj liczbe elementow zbioru n=');
readln(n);
write ('podaj liczbe k+');
readln(k)
end;
writeln;
if n>=k then
kombinacje(1,1);
writeln;
end.
program pokazuje wylosowane liczby z 80 na 20 tylko jedną kombinacje
program multilotek;
uses crt;
type
t_zakres=0..80;
const
liczby:array[1..80] of t_zakres=(1,2,3,4,5,6,7,8,9,10,
11,12,13,14,15,16,17,18,19,20,
21,22,23,24,25,26,27,28,29,30,
31,32,33,34,35,36,37,38,39,40,
41,42,43,44,45,46,47,48,49,50,
51,52,53,54,55,56,57,58,59,60,
61,62,63,64,65,66,67,68,69,70,
71,72,73,74,75,76,77,78,79,80);
var
i,j,nr_los,n,x:t_zakres;
wylosowane:array [0..20] of t_zakres;
begin
clrscr;
Randomize;
for i:=1 to 20 do
begin
nr_los:=random(80-i)+1; { nastepuje losowanie numeru liczby z tablicy Liczby}
wylosowane[i]:=Liczby[nr_los];
for n:=nr_los to 79-i do
Liczby[n]:=Liczby[n+1];
end;
for i:=2 to 20 do
begin
x:=wylosowane[i];
wylosowane[0]:=x;
j:=j-1;
while x<wylosowane [j] do
begin
wylosowane[j+1]:=wylosowane[j];
j:=j-1;
end;
wylosowane[j+1]:=x
end;
writeln('wylosowane liczby');
writeln;
for i:=1 to 20 do
write (wylosowane[i]:4);
readln
end.

Answer 3

Lotto

Opis:PROGRAM NAŚLADUJE GRĘ LICZBOWĄ DUŻY LOTEK. UŻYTKOWNIK SAM DECYDUJE, CZY WPROWADZA WŁASNE LICZBY, CZ GRA METODĄ "CHYBIŁ TRAFIŁ";

program lotto;

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('*************************');
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.