home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / bix / megabuck.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-11  |  2.6 KB  |  137 lines
  1.   {  Here in Massachusetts we have a state lottery game called
  2.      Megabucks that usually pays from $1 million to $20 million
  3.      to the grand prize winner.  All you have to do to win is
  4.      pick six numbers, in any order, from the range 1-36.
  5.  
  6.      The odds of winning are approximately 2 million to 1, as
  7.      calculated from the standard statistics function
  8.      (1/36 times 1/35 times 1/34.....).
  9.  
  10.      I personally have a hard time picking the numbers, so I
  11.      wrote myself the following little program in Turbo.      }
  12.  
  13. Program Megabucks;
  14.  
  15. Var
  16.   Ch   : Char;
  17.   I, J : Integer;
  18.   Cnt  : Integer;
  19.  
  20.   AlreadyHave : Array [1..6] of Integer;
  21.   HaveCount   : Integer;
  22.  
  23.   FName  : String[14];
  24.   O      : Text;
  25.  
  26.  
  27.  
  28.  
  29. Procedure SortNumbers;
  30. Var
  31.   S    : Integer;
  32.   T    : Integer;
  33.  
  34. Begin
  35.   S := 0;
  36.  
  37.   Repeat
  38.      S := S + 1;
  39.  
  40.      If AlreadyHave [S] > AlreadyHave [S + 1] then
  41.         Begin
  42.           T := AlreadyHave [S];
  43.           AlreadyHave [S] := AlreadyHave [S + 1];
  44.           AlreadyHave [S + 1] := T;
  45.           S := 0;
  46.           End;
  47.  
  48.         Until S = 5;
  49.  
  50.   End;
  51.  
  52.  
  53.  
  54.  
  55. Function ANumber : Integer;
  56. Var
  57.   Ti   : Integer;
  58.   H    : Boolean;
  59.   K    : Integer;
  60.  
  61. Begin
  62.  
  63.   Repeat
  64.      Delay ( Trunc( Random(500) + 50) );
  65.      Ti      := Random (35) + 1;
  66.      H := False;
  67.      For K := 1 to HaveCount do
  68.          If Ti = AlreadyHave [K] then H := True;
  69.      Until Not H;
  70.  
  71.   ANumber := Ti;
  72.   End;
  73.  
  74.  
  75.  
  76.  
  77. Begin
  78.   Randomize;
  79.  
  80.   Ch := ' ';  I := 0; J := 0; Cnt := 0;
  81.   For HaveCount := 1 to 6 do
  82.       AlreadyHave [HaveCount] := 0;
  83.   HaveCount := 0;
  84.  
  85.   LowVideo;
  86.   ClrScr;
  87.   Writeln('Here are some random numbers (1-36, groups of 6): ');
  88.   Write  ('How many sets would you like? ');
  89.   Readln (Cnt); Writeln;
  90.  
  91.   Writeln;
  92.   Writeln ('1...printer');
  93.   Writeln ('2...screen ');
  94.   Writeln ('3...disk   ');
  95.   Writeln; Writeln;
  96.   Write  ('Device for output (1-3)? ');
  97.   Repeat
  98.       Read (kbd, Ch)   Until Ch in ['1'..'3'];
  99.   Write (Ch);
  100.   Writeln;
  101.  
  102.   Case Ch of
  103.     '1' : FName := 'LST:';
  104.     '2' : FName := 'CON:';
  105.     '3' : FName := 'Lottery.Dat';
  106.     End;
  107.  
  108.   Assign (O, FName);
  109.   ReWrite (O);
  110.  
  111.  
  112.   For I := 1 to Cnt Do
  113.       Begin
  114.         Randomize;
  115.  
  116.         For HaveCount := 1 to 6 Do
  117.             AlreadyHave [HaveCount] := ANumber;
  118.         SortNumbers;
  119.  
  120.         Writeln(O);
  121.         For J := 1 to 6 Do
  122.             Write (O, AlreadyHave [J] : 6);
  123.         Writeln(O);
  124.  
  125.         For HaveCount := 1 to 6 do
  126.             AlreadyHave [HaveCount] := 0;
  127.         End;
  128.  
  129.   If Ch = '1' then
  130.      Begin
  131.        Write (O, chr(12));
  132.        End;
  133.  
  134.   Close (O);
  135.  
  136.   End.
  137.