Turbo Pascal - Programowanie Wszystko o Turbo Pascalu
Obszerny download i wiele kodów źródłowych
Menu
Kurs
Pozostałe


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.

Dodano: 2007-05-16

Twoja ocena:

 

Ocena:

[powrót]

Największy zbiór informacji o Turbo Pascalu
Copyright © 2007 by rafael. All rights reserved. : Hosting zapewnia: programuj.com turbopascal.programuj.com - programowanie najlepsze kursy w sieci unikatowe artykuły za darmo Borland Turbo Pascal 7.0