home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
library
/
dos
/
bix
/
megabuck.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-04-11
|
3KB
|
137 lines
{ Here in Massachusetts we have a state lottery game called
Megabucks that usually pays from $1 million to $20 million
to the grand prize winner. All you have to do to win is
pick six numbers, in any order, from the range 1-36.
The odds of winning are approximately 2 million to 1, as
calculated from the standard statistics function
(1/36 times 1/35 times 1/34.....).
I personally have a hard time picking the numbers, so I
wrote myself the following little program in Turbo. }
Program Megabucks;
Var
Ch : Char;
I, J : Integer;
Cnt : Integer;
AlreadyHave : Array [1..6] of Integer;
HaveCount : Integer;
FName : String[14];
O : Text;
Procedure SortNumbers;
Var
S : Integer;
T : Integer;
Begin
S := 0;
Repeat
S := S + 1;
If AlreadyHave [S] > AlreadyHave [S + 1] then
Begin
T := AlreadyHave [S];
AlreadyHave [S] := AlreadyHave [S + 1];
AlreadyHave [S + 1] := T;
S := 0;
End;
Until S = 5;
End;
Function ANumber : Integer;
Var
Ti : Integer;
H : Boolean;
K : Integer;
Begin
Repeat
Delay ( Trunc( Random(500) + 50) );
Ti := Random (35) + 1;
H := False;
For K := 1 to HaveCount do
If Ti = AlreadyHave [K] then H := True;
Until Not H;
ANumber := Ti;
End;
Begin
Randomize;
Ch := ' '; I := 0; J := 0; Cnt := 0;
For HaveCount := 1 to 6 do
AlreadyHave [HaveCount] := 0;
HaveCount := 0;
LowVideo;
ClrScr;
Writeln('Here are some random numbers (1-36, groups of 6): ');
Write ('How many sets would you like? ');
Readln (Cnt); Writeln;
Writeln;
Writeln ('1...printer');
Writeln ('2...screen ');
Writeln ('3...disk ');
Writeln; Writeln;
Write ('Device for output (1-3)? ');
Repeat
Read (kbd, Ch) Until Ch in ['1'..'3'];
Write (Ch);
Writeln;
Case Ch of
'1' : FName := 'LST:';
'2' : FName := 'CON:';
'3' : FName := 'Lottery.Dat';
End;
Assign (O, FName);
ReWrite (O);
For I := 1 to Cnt Do
Begin
Randomize;
For HaveCount := 1 to 6 Do
AlreadyHave [HaveCount] := ANumber;
SortNumbers;
Writeln(O);
For J := 1 to 6 Do
Write (O, AlreadyHave [J] : 6);
Writeln(O);
For HaveCount := 1 to 6 do
AlreadyHave [HaveCount] := 0;
End;
If Ch = '1' then
Begin
Write (O, chr(12));
End;
Close (O);
End.