|
Registriert seit: 28. Feb 2011 Ort: Mannheim 1.384 Beiträge Delphi 10.4 Sydney |
#7
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. |
Zitat |
Ansicht |
Zur Linear-Darstellung wechseln |
Zur Hybrid-Darstellung wechseln |
Baum-Darstellung |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
LinkBack URL |
About LinkBacks |