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.