Registriert seit: 28. Feb 2011
Ort: Mannheim
1.384 Beiträge
Delphi 10.4 Sydney
|
AW: Lotto Systemspiele berechnen
21. Sep 2011, 14:26
Hab’s mir mal gegeben. Sollte funktionieren.
Delphi-Quellcode:
unit uLottoTipp;
interface
uses
Classes;
type
TLottoVektor = array of integer;
TLottoMatrix = array of array of integer;
TLottotipp = class(TObject)
private
FList: TList;
FTipp: TLottoVektor;
FTipps: TLottoMatrix;
FCount, FN1, FN2: integer;
function GetFTipp(I: integer): integer;
function GetFTipps(I, J: integer): integer;
public
property Count: integer read FCount;
property N1: integer read FN1;
property N2: integer read FN2;
property Tipp[I: integer]: integer read GetFTipp;
property Tipps[I, J: integer]: integer read GetFTipps;
procedure GetTipp( const Index: integer);
constructor Create( const Count, N1, N2: integer); overload;
constructor Create( const N1, N2: integer); overload;
destructor Destroy; override;
end;
TSystemLottotipp = class(TObject)
private
FList: TList;
FTipp: TLottoVektor;
FTipps: TLottoMatrix;
FCount, FN, FN1, FN2: integer;
function GetFTipp(I: integer): integer;
function GetFTipps(I, J: integer): integer;
procedure SetTipp;
public
property Count: integer read FCount;
property N: integer read FN;
property N1: integer read FN1;
property N2: integer read FN2;
property Tipp[I: integer]: integer read GetFTipp;
property Tipps[I, J: integer]: integer read GetFTipps;
procedure GetTipps;
constructor Create( const N, N1, N2: integer);
destructor Destroy; override;
end;
function NueberK( const N, K: integer): integer;
implementation
function NueberK( const N, K: integer): integer;
var
I: integer;
begin
Result:= 1;
for I:= 1 to K do
Result:= Result*(N-I+1) div I;
end;
function InTippsList( const Index, N1: integer; const Tipps: TLottoMatrix): boolean;
var
I, J: integer;
begin
Result:= false;
for I:= 0 to Index-1 do
begin
J:= 0;
while (J <= N1-1) and (Tipps[ Index, J] = Tipps[I, J]) do
begin
if J = N1-1 then
begin
Result:= true;
Exit;
end
else
Inc(J);
end;
end;
end;
{ TLottotipp }
constructor TLottotipp.Create( const Count, N1, N2: integer);
begin
// N1 <= N2
// Count <= N2 über N1
inherited Create;
FList:= TList.Create;
FCount:= Count;
FN1:= N1;
FN2:= N2;
SetLength(FTipp, FN1);
SetLength(FTipps, FCount, FN1);
Randomize;
end;
constructor TLottotipp.Create( const N1, N2: integer);
begin
Create(1, N1, N2);
end;
destructor TLottotipp.Destroy;
begin
FList.Free;
SetLength(FTipp, 0);
SetLength(FTipps, 0);
inherited Destroy;
end;
function TLottotipp.GetFTipp(I: integer): integer;
begin
Result:= FTipp[I];
end;
function TLottotipp.GetFTipps(I, J: integer): integer;
begin
Result:= FTipps[I, J];
end;
procedure TLottotipp.GetTipp( const Index: integer);
var
I, J, T: integer;
begin
repeat
FList.Clear;
for I:= 1 to FN2 do
FList.Add(Pointer(I));
for I:= 0 to FN1-1 do
begin
J:= Random(FList.Count);
FTipp[I]:= Integer(FList[J]);
FList.Delete(J);
end;
for I:= 0 to FN1-2 do
for J:= I+1 to FN1-1 do
if FTipp[I] > FTipp[J] then
begin
T:= FTipp[I];
FTipp[I]:= FTipp[J];
FTipp[J]:= T;
end;
for J:= 0 to FN1-1 do
FTipps[ Index, J]:= FTipp[J];
until not InTippsList( Index, FN1, FTipps);
end;
{ TSystemLottotipp }
constructor TSystemLottotipp.Create( const N, N1, N2: integer);
begin
// N1 <= N2
// N >= N1, N <= N2
inherited Create;
FList:= TList.Create;
FN:= N;
FN1:= N1;
FN2:= N2;
SetLength(FTipp, FN);
FCount:= NueberK(FN, FN1);
SetLength(FTipps, FCount, FN1);
Randomize;
end;
destructor TSystemLottotipp.Destroy;
begin
FList.Free;
SetLength(FTipp, 0);
SetLength(FTipps, 0);
inherited Destroy;
end;
function TSystemLottotipp.GetFTipp(I: integer): integer;
begin
Result:= FTipp[I];
end;
function TSystemLottotipp.GetFTipps(I, J: integer): integer;
begin
Result:= FTipps[I, J];
end;
procedure TSystemLottotipp.SetTipp;
var
I, J, T: integer;
begin
FList.Clear;
for I:= 1 to FN2 do
FList.Add(Pointer(I));
for I:= 0 to FN-1 do
begin
J:= Random(FList.Count);
FTipp[I]:= Integer(FList[J]);
FList.Delete(J);
end;
for I:= 0 to FN-2 do
for J:= I+1 to FN-1 do
if FTipp[I] > FTipp[J] then
begin
T:= FTipp[I];
FTipp[I]:= FTipp[J];
FTipp[J]:= T;
end;
end;
procedure TSystemLottotipp.GetTipps;
var
I, J, Index, T: integer;
A: boolean;
ATipp: TLottoVektor;
begin
SetTipp;
SetLength(ATipp, FN1);
Index:= 0;
repeat
repeat
FList.Clear;
for I:= 0 to FN-1 do
FList.Add(Pointer(I));
for I:= 0 to FN1-1 do
begin
J:= Random(FList.Count);
T:= Integer(FList[J]);
ATipp[I]:= FTipp[T];
FList.Delete(J);
end;
for I:= 0 to FN1-2 do
for J:= I+1 to FN1-1 do
if ATipp[I] > ATipp[J] then
begin
T:= ATipp[I];
ATipp[I]:= ATipp[J];
ATipp[J]:= T;
end;
for J:= 0 to FN1-1 do
FTipps[ Index, J]:= ATipp[J];
A:= InTippsList( Index, FN1, FTipps);
if not A then Inc( Index);
until not A;
until Index = FCount;
end;
end.
Delphi-Quellcode:
unit LottoTippUnit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
uLottoTipp;
function LottoTippString( const LottoTipp: TLottoTipp; const I: integer): string;
var
J: integer;
begin
Result:= ' ';
for J:= 0 to LottoTipp.N1-1 do
Result:= Result + IntToStr(LottoTipp.Tipps[I, J])+' ';
Result:= TrimRight(Result);
end;
function SystemLottoTippString( const LottoTipp: TSystemLottoTipp; const I: integer): string;
var
J: integer;
begin
Result:= ' ';
for J:= 0 to LottoTipp.N1-1 do
Result:= Result + IntToStr(LottoTipp.Tipps[I, J])+' ';
Result:= TrimRight(Result);
end;
function TheSystemLottoTippString( const LottoTipp: TSystemLottoTipp): string;
var
I: integer;
begin
Result:= ' ';
for I:= 0 to LottoTipp.N-1 do
Result:= Result + IntToStr(LottoTipp.Tipp[I])+' ';
Result:= TrimRight(Result);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
LottoTipp: TLottoTipp;
I: integer;
begin
// LottoTipp:= TLottoTipp.Create(NueberK(49, 6), 6, 49); // AUA
LottoTipp:= TLottoTipp.Create(100, 6, 49);
Memo1.Clear;
Memo1.Lines.BeginUpdate;
try
for I:= 0 to LottoTipp.Count-1 do
LottoTipp.GetTipp(I);
Caption:= IntToStr(LottoTipp.Count)+' Tipps';
for I:= 0 to LottoTipp.Count-1 do
Memo1.Lines.Add(LottoTippString(LottoTipp, I));
except
on E: Exception do
ShowMessage(' Fehler vom Typ: '+E.ClassName+' , Meldung: '+E. Message);
end;
LottoTipp.Free;
Memo1.Lines.EndUpdate;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
LottoTipp: TSystemLottoTipp;
I: integer;
begin
LottoTipp:= TSystemLottoTipp.Create(16, 6, 49);
Memo1.Clear;
Memo1.Lines.BeginUpdate;
try
LottoTipp.GetTipps;
Caption:= IntToStr(LottoTipp.Count)+' Tipps';
Memo1.Lines.Add(TheSystemLottoTippString(LottoTipp));
Memo1.Lines.Add(' ');
for I:= 0 to LottoTipp.Count-1 do
Memo1.Lines.Add(SystemLottoTippString(LottoTipp, I));
except
on E: Exception do
ShowMessage(' Fehler vom Typ: '+E.ClassName+' , Meldung: '+E. Message);
end;
LottoTipp.Free;
Memo1.Lines.EndUpdate;
end;
end.
|