Registriert seit: 26. Aug 2004
Ort: Nebel auf Amrum
3.154 Beiträge
Delphi 7 Enterprise
|
Re: Zufallszahlen im Bereich Von-Bis, ohne Zurücklegen
4. Jul 2008, 17:41
Delphi-Quellcode:
// Demo
var Zfall: Tzfzozl;
begin
// Lottozahlen 6 aus 49
zFall := Tzfzozl.Create(1, 49, 6, true);
try
write('Zufallszahlen: ');
while not zFall.EOF do
write(zfall.Next:3);
finally
zFall.Free;
end;
readln;
end.
Delphi-Quellcode:
type
// Liefert die Zufallszahlen im Bereich Von-Bis ohne zurücklegen
// Wenn Unique = True, werden keine doppelten Zahlen in den Pool aufgenommen
// Über Initialize kann eine Neuinitialisierung der Ziehung erfolgen
Tzfzozl = class
strict private
fArray: array of integer;
procedure RemoveAndMix(aIndex: Integer);
function GetCount: integer;
public
constructor Create(Von, Bis, Anzahl: Integer; Unique: boolean = false);
procedure Initialize(Von, Bis, Anzahl: Integer; Unique: boolean = false);
property Count: integer read GetCount;
function First: Integer;
function Next: Integer;
function EOF: boolean;
end;
constructor Tzfzozl.Create(Von, Bis, Anzahl: Integer; Unique: boolean = false);
begin
inherited create;
Initialize(von, bis, Anzahl, Unique);
end;
procedure Tzfzozl.Initialize(Von, Bis, Anzahl: Integer; Unique: boolean = false);
function IsXinArr(Bis, X: integer): boolean;
var i: integer;
begin
result := false;
i:=0;
while (i <= bis) and not result do
begin
if fArray[i] = x then
result := true;
inc(i);
end;
end;
var i, x: integer;
canUnique: boolean;
begin
canUnique := (bis - von >= anzahl);
setLength(fArray, 0);
if (bis > von) and CanUnique then
begin
setlength(fArray, Anzahl);
for i := 0 to high(fArray) do
begin
if not Unique then
fArray[i] := random(bis-von+1)+von
else
begin
repeat
x := random(bis-von+1)+von;
until not IsXinArr(i-1, x);
fArray[i] := x;
end;
end;
end;
end;
function Tzfzozl.EOF: boolean;
begin
result := length(fArray) = 0;
end;
function Tzfzozl.First: Integer;
begin
if count > 0 then
result := Next
else
result := -1; //-1 wenn fehler aufgetreten
end;
function Tzfzozl.Next: Integer;
var i: integer;
begin
result := -1;
if not Eof then
begin
i := random(length(fArray));
result := fArray[i];
RemoveAndMix(i);
end;
end;
function Tzfzozl.GetCount: integer;
begin
result := length(FArray);
end;
procedure Tzfzozl.RemoveAndMix(aIndex: Integer);
procedure Shuffle;
var i, x, y: integer;
begin
for i := low(fArray)+1 to high(fArray) do
begin
y := i + Random(Length(fArray) -i);
x := fArray[i-1];
fArray[i-1] := fArray[y];
fArray[y] := x;
end;
end;
var i: integer;
begin
for i := aIndex + 1 to high(fArray) do
fArray[i-1] := fArray[i];
setlength(fArray, high(FArray));
Shuffle;
end;
initialization
Randomize;
|
|
Zitat
|