Rangieren in Delphi über Listen

[Royale]

Wie der Titel schon sagt, ein Rangierprogramm mit Delphi über Listen. War ein Unterrichtsproject.

Delphi-Quellcode:

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, mliste2, ExtCtrls, Buttons;

// *********************************************************************************
// TWaggon

type
    TWaggon = class(TObject)
    public
          Name: string;
end;

// *********************************************************************************
// TGleis

type
    TGleis = class(TStapel)
    public
          // ListBox, in der die aktuelle Belegung des Gleises angezeigt werden soll

          ListBox: TListBox;

          constructor Create; override;

          // Funktionen, die auch die ListBox-Ausgabe ändern müssen

          procedure Push(Element: TObject); override;
          procedure Pop; override;
end;

// ********************************************************************************

type
  TForm1 = class(TForm)
    GleisALbx: TListBox;
    GleisCLbx: TListBox;
    GleisBLbx: TListBox;
    WaggonAnzahlEdt: TEdit;
    Label1: TLabel;
    WaggonsErzeugenBtn: TBitBtn;
    RangierenBtn: TBitBtn;
    Label2: TLabel;
    Label3: TLabel;
    Image1: TImage;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    BitBtn1: TBitBtn;
    Label7: TLabel;
    procedure WaggonsErzeugenBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RangierenBtnClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    

  private
    { Private-Deklarationen}
  public
    { Public-Deklarationen}
  end;

var
  Form1: TForm1;
  GleisA, GleisB, GleisC: TGleis;

implementation

{$R *.DFM}

// ******************************************************************************
// TGleis

constructor TGleis.Create;
begin
     inherited Create;
     
     ListBox := nil;
end;

procedure TGleis.Push(Element: TObject);
begin
     inherited Push(Element);

     // ggf. Änderung auch in der ListBox ausführen

     if ListBox <> nil then
     begin
          ListBox.items.insert(0, TWaggon(Top).Name);
          ListBox.repaint;
     end;
end;

procedure TGleis.Pop;
begin
     inherited Pop;

     // ggf. Änderung auch in der ListBox ausführen

     if ListBox <> nil then
     begin
          ListBox.items.delete(0);
          ListBox.repaint;
     end;
end;

// *************************************************************************
// annfang

procedure TForm1.FormCreate(Sender: TObject);
begin
     // Gleis-dinger machen

     GleisA := TGleis.create;
     GleisB := TGleis.create;
     GleisC := TGleis.create;

     // Den Gleisen eine ListBox zuweisen

     GleisA.ListBox := GleisALbx;
     GleisB.ListBox := GleisBLbx;
     GleisC.ListBox := GleisCLbx;



     randomize;
end;

// Erzeugen  zufälliger Waggon auf A

procedure TForm1.WaggonsErzeugenBtnClick(Sender: TObject);
var
   anzahl, i: integer;
   waggon: TWaggon;
begin
     //  Anzahl der Waggons reintuen

     try
        anzahl := strtoint(WaggonAnzahlEdt.text);
     except
           showmessage('MÖÖP, falsch');
           exit;

     end;


     //*****************************************
     for i := 1 to anzahl do
     begin                                     // Waggons erzeugen


          waggon := TWaggon.create;
          waggon.name := chr(trunc(random(25)) + 65);       //ascci ansprechung der buchstaben

          // Neuen Waggon auf Gleis A hinzufügen.

          GleisA.push(waggon);
     end;
     //*****************************************
end;

// BEGINN SORTIEREN

procedure TForm1.RangierenBtnClick(Sender: TObject);
var
   KleinsterName: string;
begin
     // ausführen, bis fertig
     while not GleisA.IsEmpty do
     begin
          // speichern kleinster waggon um zu wissen welcher auf Gleis C muss und speichern

          KleinsterName := '';

          // alle auf b verschieben :-: den ersten waggon auf a ermitteln beim vorgang



          while not GleisA.IsEmpty do
          begin
               // Name des aktuell ersten Waggons auf Gleis A alphabetisch vor
               // dem bisher alphabetisch kleinsten Namen der verbliebenen
               // Waggons?

               if (KleinsterName = '') or (TWaggon(GleisA.Top).Name < KleinsterName) then
                  KleinsterName := TWaggon(GleisA.Top).Name;

               // waggon von a auf b verschieben
               // und a löschen

               GleisB.Push(GleisA.Top);
               GleisA.Pop;

               // pause zum nachvollziehen

               sleep(100);
          end;

          // Verschieben nach c oder nach a zurück

          while not GleisB.IsEmpty do
          begin
               // Entscheidung a oder c

               if TWaggon(GleisB.Top).Name = KleinsterName then
                  GleisC.Push(GleisB.Top)
               else
                   GleisA.Push(GleisB.Top);

               // und auf B löschen.

               GleisB.Pop;

               // warten zum nachvollziehen

               sleep(100);
          end;
     end;


     {verwendete listenbefehle: push=   element einfügen
                                pop: element aus liste ermitteln und löschen}
end;





procedure TForm1.BitBtn1Click(Sender: TObject);
begin
form1.Close;
end;

end.