AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Ordung muss sein

Ein Thema von block35plus1 · begonnen am 2. Okt 2003 · letzter Beitrag vom 2. Mär 2004
Antwort Antwort
Benutzerbild von Billa
Billa

Registriert seit: 11. Aug 2003
239 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#1

Re: Ordung muss sein

  Alt 21. Okt 2003, 08:32
Hallo zusammen,

@negaH: Sorry, aber ich hatte wirklich viel zu tun und war ein paar Tage nicht up-to-date....

Hier ist jetzt meine kleine "Spontanlösung". Die hat sicherlich noch reichlich Mängel, und ich habe nicht alle Eure Postings berücksichtigt. Aber sei's drum:

Code:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  MaxKugeln = 49;

type
  PElement = ^TElement;
  TElement = record
            Wert : integer;
            Text : string;
            Next : PElement;
          end;

var
  Anfang : PElement;
  AnzKugeln : Integer;

procedure RingErzeugen( var Anfang : PElement; var AnzElemente : Integer; MaxElemente : integer );
var
  i : integer;
  Element : PElement;
begin

  // 1.Element auf alle Fälle erzeugen erzeugen
  try
    New( Anfang );
    with Anfang^ do
    begin
      Wert := 1;
      Text := IntToStr( Wert ); // beliebig, aber beim Lotto eben ein Zahlensymbol
      New( Next );
      Next := Anfang;  // Ring schließen
    end;
    AnzElemente := 1;
  except
  end;

  // falls erfolgreich, folgende Elemente erzeugen und in den Ring "einklinken"
  if AnzElemente = 1 then
  for i := 2 to MaxElemente do
  begin
    try
      New( Element );    //erzeugen
      with Element^ do
      begin
        Wert := i;
        Text := IntToStr( Wert );  // benennen
        New( Next );
        Next := Anfang^.Next;  // Ring schließen
      end;
      Anfang^.Next := Element;
      Inc( AnzElemente );
    except
    end;
  end;
  // kleiner "Schönheitsfehler": die Reihe ist absteigend geordnet, aber es müssen ja
  // keine Zahlen sein...
end;

procedure EntnehmeElement( var Anfang : PElement; var Ergebnis : TElement; var AnzElemente : integer );
var
  Hilfszeiger : PElement;
  i,
  Zufallszahl : Integer;
begin
  if AnzElemente <> 0 then
  begin

    // Es ist nützlich, nicht das gesuchte Element,
    // sondern seinen Vorgänger zu finden, da sonst
    // wegen der einfachen Verkettung der Vorgänger
    // mühsam gesucht werden müsste ...
    // ( also nicht wie üblich Random(X)+1 )
    // ...und damit sich auf jeden Fall etwas "bewegt"
    // wird einfach die Anzahl der Elemente addiert.
    // Das ist beim Durchlaufen des Rings neutral.
    // ( und nur Spielerei )
    Zufallszahl := Random( AnzElemente ) + AnzElemente;

    // bewege den Zeiger zum ausgelosten Element
    for i := 1 to Zufallszahl do
      Anfang := Anfang^.Next;
    // Wert zuweisen
    Ergebnis := Anfang^.Next^;

    // Element aus dem Ring entfernen
    Hilfszeiger := Anfang^.Next;
    Anfang^.Next := Hilfszeiger^.Next;
    try
      Dispose( Hilfszeiger );
      Dec( AnzElemente );
    except
    end;

  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  Run : integer;
  Ergebnis : TElement;
begin

  // Vorbereitung
  Randomize;
  Memo1.Lines.Clear;

  // Aufbauen ....
  RingErzeugen( Anfang, AnzKugeln, MaxKugeln );

  // Lotto spielen ....
  for Run := 1 to 7 do
  begin
    EntnehmeElement( Anfang, Ergebnis, AnzKugeln );
    Memo1.Lines.Add( Ergebnis.Text );
  end;

  // Abräumen ....
  while AnzKugeln > 0 do
    EntnehmeElement( Anfang, Ergebnis, AnzKugeln );

end;

end.
...und jetzt werden die Bestien mich zerreissen...
Gruß Billa

Nur weil ich paranoid bin, heißt das nicht, daß die da draussen nicht hinter mir her sind....
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es 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

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 21:34 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz