Ruleta v Pascalu – Pascal – Fórum – Programujte.com

Zdravím, potřeboval bych pomoct s programem do školy (jsem středoškolák a tohle zadání jsme dostali na druhé hodině - poprvé programuji). Programujem v překladači Lazarus. Díky moc za pomoc. :)
 

Stručný popis, jak by měl program fungovat:

Počáteční stav je, že uživatel má 100 eur (mějte proměnnou typu integer třeba s názvem "eura")
Program se uživatele vždy zeptá na to kolik chce vsadit a zda na liché či sudé (zapíše se do proměnných "sazka" a "barva" obě budou celá čisla, sazka je jasná, do barvy se taky zadavá čislo, pričemž 0 znamená sudá a 1 lichá)
Počítač vygeneruje a zapamatuje si náhodné číslo od 0 do 36 (název "hod", typ integer)
Pokud je číslo typu, na který hráč vsadil ( hod mod 2 = barva - vysvětlení mod=modulo je celočíselný zbytek po dělení, jelikož je to dělení dvojkou vrací buď nula pro sudá čísla, nebo jedna pro lichá a jde tak přímo porovnat s barvou) vyhrává hráč vsazenou částku v opačném případě ji ztrácí.
Vypište jaké číslo padlo a jaký je aktuální stav uživatelova konta.
Zeptejte se hráče zda chce pokračovat ve hře (odpověď bude opět císlo, 0 znamená ukončit hru, ostatni pokračovat)
Opakujte od začátku

#1 Jan
No a s čím potřebuješ pomoct?

#2 JoDiK
Prakticky se všim, jediné co dokážu je deklarace proměnné, readln, writeln, ukončení a ještě readln(). :( .. nejlíp bych potřeboval celej zdroják.

#3 Jan
Aha, a chceš se to naučit, nebo jen potřebuješ odevzdat hotovej program?

#1 Jan
Jenom tě chci upozornit, že musíš ještě ošetřit stav, kdy padne 0. (protože 0 mod 2 = 0, a nula není sudé číslo (a ani se na něj v ruletě navyhrává pokud jsi ho přímo nevsadil))

Potřebuji jen alespoň trošku funkční zdrojový kod.

Potřebuji to nejpozději do zítřejší 10 hodiny (dopoledne) odevzdat :-( .

Já až ten zdroják uvidim, tak to pochopim proč to tak je. Ale já nedokážu vymyslet nějaký algoritmus sám. :/

#8 Jan

var
  Application: TMyApplication;
  eura,pokr,sazka,barva,hod: Integer;
  chyba: LongInt;
{$IFDEF WINDOWS}{$R Ruleta.rc}{$ENDIF}

begin
  WriteLn(' ----------------- Ruleta ---------------');
  eura := 100;
  pokr := 1;
  Randomize;
  WriteLn;
  Writeln(' Mas k dispozici 100 eur');
  while (pokr=1)and(eura>0) do
  begin
    repeat           //Dokud se nezada cislo porad opakujeme zadani
      WriteLn;
      Write(' Zadej kolik eur chces vsadit: ');
      {$I-} ReadLn(sazka); {$I+} //Osetreni spatnych vstupu-napr.pismena
      chyba := IOResult;
      if chyba<>0 then
        WriteLn(' Sazka musi byt cislo');
    until chyba=0;
    if (sazka<=0)or(sazka>eura) then    //Pokud zadame cislo vetsi nez kolik mame
      repeat                            //tak to nedovolime
        WriteLn(' Sazka musi byt vetsi nez nula a mensi nez kolik mas eur');
        Writeln(' Mas k dispozici ',eura,' eur');
        WriteLn;
        Write(' Zadej kolik eur chces vsadit: ');
        ReadLn(sazka);
      until (sazka>0)and(sazka<=eura);

    repeat           //Dokud se nezada cislo porad opakujeme zadani
      WriteLn;
      Write(' Zadej zda sazis na sude nebo liche (0-sude,1-liche}: ');
      {$I-} ReadLn(barva); {$I+} //Osetreni­ spatnych vstupu-napr.pismena
      chyba := IOResult;
      if chyba<>0 then
        WriteLn(' Musis zadat cislo 0 nebo 1');
    until chyba=0;
    if barva>1 then    //Pokud nazadame 0 nebo 1 tak to nedovolime
      repeat
        WriteLn(' Musis zadat cislo 0 nebo 1');
        WriteLn;
        Write(' Zadej zda sazis na sude nebo liche (0-sude,1-liche}: ');
        ReadLn(barva);
      until (barva=0)or(barva=1);
  //pogram
  hod := Random(37);
  if hod=0 then
    eura := eura-sazka
  else
    if ((hod mod 2=0)and(barva=0))or((hod mod 2=1)and(barva=1)) then
      eura := eura+sazka
    else
      eura := eura-sazka;
  WriteLn;
  WriteLn(' Padlo cislo ',hod,' a mas k dispozici ',eura,' eur');
  if eura>0 then
  begin
    repeat           //Dokud se nezada cislo porad opakujeme zadani
      WriteLn;
      Write(' Nova sazka? (1-ano(pokracovat),0-ne (konec)}: ');
      {$I-} ReadLn(pokr); {$I+} //Osetreni­ spatnych vstupu-napr.pismena
      chyba := IOResult;
      if chyba<>0 then
        WriteLn(' Musis zadat 0 nebo 1');
    until chyba=0;
    if pokr>1 then    //Pokud nazadame 0 nebo 1 tak to nedovolime
      repeat
        WriteLn(' Musis zadat 0 nebo 1');
        WriteLn;
        Write(' Nova sazka? (1-ano(pokracovat),0-ne (konec)}: ');
        ReadLn(pokr);
      until (pokr=0)or(pokr=1);
  end
  else
  begin
    WriteLn;
  WriteLn(' Uz nemas zadna eura, tak ahoj');
  WriteLn(' Pro ukonceni stiskni Enter');
  ReadLn;
  end;
end;

#8 Jan
Ještě přepiš řádek

if barva>1 then 

na 

if (barva<0)or(barva>1) then

a řádek

if pokr>1 then 

na 

if pokr<0)or(pokr>1) then

Díky moc :))))))) !!!!!! 

Hlásí mi to:

Připojen obrázek.

 :/

#12 Jan
Já jsem ti napsal jenom tělo programu. To co tam je předtím a zatím jsem neřešil. Hláška znamená, že ti asi někde chybí end.

Celý program vypadá takto: (u mě v Lazarusu jako konzolová aplikace)

program Ruleta;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp
  { you can add units after this };

type

  { TMyApplication }

  TMyApplication = class(TCustomApplication)
  protected
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
  end;

{ TMyApplication }

procedure TMyApplication.DoRun;
var
  ErrorMsg: String;
begin
  // quick check parameters
  ErrorMsg:=CheckOptions('h','help');
  if ErrorMsg<>'' then begin
    ShowException(Exception.Create(ErrorMsg));
    Halt;
  end;

  // parse parameters
  if HasOption('h','help') then begin
    WriteHelp;
    Halt;
  end;

  { add your program here }

  // stop program loop
  Terminate;
end;

constructor TMyApplication.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException:=True;
end;

destructor TMyApplication.Destroy;
begin
  inherited Destroy;
end;

procedure TMyApplication.WriteHelp;
begin
  { add your help code here }
  writeln('Usage: ',ExeName,' -h');
end;

var
  Application: TMyApplication;
  eura,pokr,sazka,barva,hod: Integer;
  chyba: LongInt;
{$IFDEF WINDOWS}{$R Ruleta.rc}{$ENDIF}

begin
  WriteLn(' ----------------- Ruleta ---------------');
  eura := 100;
  pokr := 1;
  Randomize;
  WriteLn;
  Writeln(' Mas k dispozici 100 eur');
  while (pokr=1)and(eura>0) do
  begin
    repeat           //Dokud se nezada cislo porad opakujeme zadani
      WriteLn;
      Write(' Zadej kolik eur chces vsadit: ');
      {$I-} ReadLn(sazka); {$I+} //Osetreni­ spatnych vstupu-napr.pismena nebo desetinna cisla
      chyba := IOResult;
      if chyba<>0 then
        WriteLn(' Sazka musi byt cele cislo');
    until chyba=0;
    if (sazka<=0)or(sazka>eura) then    //Pokud zadame cislo vetsi nez kolik mame
      repeat                            //tak to nedovolime
        WriteLn(' Sazka musi byt vetsi nez nula a mensi nez kolik mas eur');
        Writeln(' Mas k dispozici ',eura,' eur');
        WriteLn;
        Write(' Zadej kolik eur chces vsadit: ');
        ReadLn(sazka);
      until (sazka>0)and(sazka<=eura);

    repeat           //Dokud se nezada cislo porad opakujeme zadani
      WriteLn;
      Write(' Zadej zda sazis na sude nebo liche (0-sude,1-liche}: ');
      {$I-} ReadLn(barva); {$I+} //Osetreni­ spatnych vstupu-napr.pismena nebo desetinna cisla
      chyba := IOResult;
      if chyba<>0 then
        WriteLn(' Musis zadat cislo 0 nebo 1');
    until chyba=0;
    if (barva<0)or(barva>1) then    //Pokud nezadame 0 nebo 1 tak to nedovolime
      repeat
        WriteLn(' Musis zadat 0 nebo 1');
        WriteLn;
        Write(' Zadej zda sazis na sude nebo liche (0-sude,1-liche}: ');
        ReadLn(barva);
      until (barva=0)or(barva=1);
  //pogram
  hod := Random(37);
  if hod=0 then
    eura := eura-sazka
  else
    if ((hod mod 2=0)and(barva=0))or((hod mod 2=1)and(barva=1)) then
      eura := eura+sazka
    else
      eura := eura-sazka;
  WriteLn;
  WriteLn(' Padlo cislo ',hod,' a mas k dispozici ',eura,' eur');
  if eura>0 then
  begin
    repeat           //Dokud se nezada cislo porad opakujeme zadani
      WriteLn;
      Write(' Nova sazka? (1-ano(pokracovat),0-ne (konec)}: ');
      {$I-} ReadLn(pokr); {$I+} //Osetreni­ spatnych vstupu-napr.pismena nebo desetinna cisla
      chyba := IOResult;
      if chyba<>0 then
        WriteLn(' Musis zadat cislo 0 nebo 1');
    until chyba=0;
    if (pokr<0)or(pokr>1) then    //Pokud nezadame 0 nebo 1 tak to nedovolime
      repeat
        WriteLn(' Musis zadat 0 nebo 1');
        WriteLn;
        Write(' Nova sazka? (1-ano(pokracovat),0-ne (konec)}: ');
        ReadLn(pokr);
      until (pokr=0)or(pokr=1);
  end
  else
  begin
    WriteLn;
  WriteLn(' Uz nemas zadna eura, tak ahoj');
  WriteLn(' Pro ukonceni stiskni Enter');
  ReadLn;
  end;
end;

  Application:=TMyApplication.Create(nil);
  Application.Title:='My Application';
  Application.Run;
  Application.Free;
end.

ahojte ponukam ludom blizkym rulete si vyhrat usd, euro... ruletu neni mozne porazit ziadnym systemom a ani matematicky ju uhrat nakolko casina nam postavili limilty na stoloch ale ja osobne som ju otvoril ...ak mas zaujem si zahrat ruletu a vyhrat pisni na,       nechcem zato ziadny peniaz.
mariorebel111@gmail.com