home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / pp_demo / lotto.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-10-23  |  1.6 KB  |  87 lines
  1. program lotto;
  2.  
  3. uses crt;
  4.  
  5. const kugeln = 6;
  6.  
  7. type     zahlenarray = array[1..kugeln] of integer;
  8.  
  9. var        Lottozahlen : zahlenarray;
  10.         ende        : boolean;
  11.  
  12. procedure init(var feld : zahlenarray);
  13.     var i : integer;
  14. begin
  15.     for i:=1 to kugeln do
  16.         feld[i]:=0;
  17. end;
  18.  
  19. procedure sort(var feld : zahlenarray);
  20.     var i, j, temp : integer;
  21. begin
  22.     for i:=6 downto 2 do
  23.     begin
  24.         for j:=2 to i do
  25.         begin
  26.             if feld[j-1]>feld[j] then
  27.             begin
  28.                 temp:=feld[j];
  29.                     feld[j]:=feld[j-1];
  30.                     feld[j-1]:=temp;
  31.             end;
  32.         end;
  33.     end;
  34. end;
  35.  
  36. procedure berechnezahlen(var feld : zahlenarray);
  37.     var i, j : integer;
  38.         nochmal : boolean;
  39. begin
  40.     for i:=1 to kugeln do
  41.     begin
  42.         nochmal:=FALSE;
  43.         repeat
  44.             feld[i]:=Random(49)+1;
  45.               IF i>1 THEN
  46.             begin
  47.                 nochmal:=false;
  48.                 for j:=1 to i-1 do
  49.                 begin
  50.                     if feld[i]=feld[j] then nochmal:=true;
  51.                 end;
  52.               end;
  53.         until (nochmal=FALSE);
  54.     end;
  55. end;
  56.  
  57. procedure writezahlen(var feld : zahlenarray);
  58.     var i : integer;
  59.         str: string;
  60.         c  : char;
  61. begin
  62.     str:=' ';
  63.     ClrScr;
  64.     Writeln('Das Programm berechnet 6 Zahlen für das Samstag-Lotto');
  65.     Writeln;
  66.     for i:=1 to kugeln do
  67.     begin
  68.         writeln(feld[i]);
  69.     end;
  70.     Writeln;
  71.     Writeln('Weiter mit Taste, Eingabe von ''e'' beendet');
  72.     c:=readkey;
  73.     if (c='e') or (c='E') then ende:=true;
  74. end;
  75.  
  76.     (* main *)
  77.  
  78. begin
  79.     ende:=false;
  80.     Randomize;
  81.     repeat    
  82.         init(Lottozahlen);
  83.         berechnezahlen(Lottozahlen);
  84.         sort(Lottozahlen);
  85.         writezahlen(Lottozahlen);
  86.     until (ende=true);
  87. end.