unit Busanzeige1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;
type
TBusEintrag =
record
Linie:
string;
Ziel:
string;
Ankunft: TDateTime;
Abfahrt: TDateTime;
Verspätung: TDateTime;
end;
PBusEintrag = ^TBusEintrag;
type
TForm1 =
class(TForm)
ListBox1: TListBox;
TLabel1: TLabel;
TLabel2: TLabel;
TLabel3: TLabel;
TLabel4: TLabel;
TLabel5: TLabel;
Hinzufügen: TButton;
alleLinien: TButton;
Linie: TEdit;
Ziel: TEdit;
Ankunft: TEdit;
Abfahrt: TEdit;
Verspätung: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
bearbeiten: TButton;
löschen: TButton;
zehnAnzeigen: TButton;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Beenden: TBitBtn;
procedure HinzufügenClick(Sender: TObject);
procedure BeendenClick(Sender: TObject);
procedure alleLinienClick(Sender: TObject);
procedure löschenClick(Sender: TObject);
procedure zehnAnzeigenClick(Sender: TObject);
procedure bearbeitenClick(Sender: TObject);
private
Liste :
Array of PBusEintrag;
procedure Add;
procedure Delete;
procedure Output(LängeListe:integer);
procedure Quicksort(
var Liste :
Array of PBusEintrag; erstes,letztes:integer);
procedure WertTauschen(
var Liste :
Array of PBusEintrag; StelleA, StelleB: Integer);
end;
Var
Form1 : TForm;
implementation
{$R *.dfm}
procedure TForm1.WertTauschen
(
var Liste :
Array of PBusEintrag; StelleA, StelleB: Integer);
var tempI: PBusEintrag;
begin
tempI := Liste[StelleA];
Liste[StelleA] := Liste[StelleB];
Liste[StelleB] := tempI;
end;
procedure TForm1.Delete;
var
MakierteStelle: integer;
rec_p: PBusEintrag;
begin
rec_p:=Liste[ListBox1.ItemIndex];
Dispose(rec_p);
MakierteStelle:= ListBox1.ItemIndex;
//Makierte Stelle kommt an das Ende des Arrays
while MakierteStelle<high(Liste)
do begin
Liste[MakierteStelle]:=Liste[MakierteStelle+1];
MakierteStelle:=MakierteStelle+1;
end;
//Array wird um 1 verringert
setLength(Liste,Length(Liste)-1);
//Makierter Eintrag wird aus ListBox entfernt
ListBox1.DeleteSelected;
end;
procedure TForm1.Output(LängeListe:integer);
const
MAX_TABS = 4;
Tab = #9;
var
Tabulators:
array[0..MAX_TABS]
of Integer;
StelleEintrag: integer;
begin
//Tabulatorweiten festlegen
Tabulators[0] := 30;
Tabulators[1] := 100;
Tabulators[2] := 204;
Tabulators[3] := 1;
Tabulators[4] := 1;
ListBox1.TabWidth := 1;
//Tabulatoren setzen
SendMessage(ListBox1.Handle, LB_SETTABSTOPS, MAX_TABS, Longint(@Tabulators));
//ListBox leeren
ListBox1.clear;
//Liste ausgeben
StelleEintrag:=0;
//Wenn Verspätung größer als Pause zwischen Ankunft und Abfahrt,
// dann Abfahrt verändern
if Frac(Liste[StelleEintrag].Abfahrt-Liste[StelleEintrag].Ankunft)
<Frac(Liste[StelleEintrag].Verspätung)
then begin
while StelleEintrag < length(Liste)
do begin
ListBox1.Items.Strings[StelleEintrag]:=
'
'+Liste[StelleEintrag].Linie+ Tab +
Liste[StelleEintrag].Ziel+Tab+
(DateTimeToStr(Liste[StelleEintrag].Ankunft+
Frac(Liste[StelleEintrag].Verspätung)))+
'
Uhr'+Tab+
TimeToStr(Liste[StelleEintrag].Verspätung)+Tab+'
h';
StelleEintrag:=StelleEintrag+1;
end;
end else
//Wenn Verspätung kleiner als Pause zwischen Ankunft und Abfahrt,
//dann Abfahrt nicht verändern
while StelleEintrag < length(Liste)
do begin
ListBox1.Items.Strings[StelleEintrag]:=
'
'+Liste[StelleEintrag].Linie+ Tab +
Liste[StelleEintrag].Ziel+Tab+
DateTimeToStr(Liste[StelleEintrag].Abfahrt)+'
Uhr'+Tab+
TimeToStr(Liste[StelleEintrag].Verspätung)+Tab+'
h';
StelleEintrag:=StelleEintrag+1;
end;
end;
procedure TForm1.Quicksort
(
var Liste :
Array of PBusEintrag; erstes,letztes:integer);
var
vonLinks, vonRechts, mitte:integer;
vergleichsElement: TDateTime;
begin
if erstes < letztes
then begin
mitte := (erstes + letztes)
div 2;
vergleichsElement := (Liste[mitte].Ankunft+Liste[mitte].Verspätung);
vonLinks := erstes;
vonRechts := letztes;
//noch nicht fertig zerlegt?
while vonLinks <= vonRechts
do begin
while (Liste[vonLinks].Ankunft+Frac(Liste[vonLinks].Verspätung))
< vergleichsElement
do
vonLinks := vonLinks + 1;
while (Liste[vonRechts].Ankunft+Frac(Liste[vonRechts].Verspätung))
> vergleichsElement
do
vonRechts := vonRechts - 1;
if vonLinks <= vonRechts
then begin
//Elemente tauschen
WertTauschen(Liste, vonLinks, vonRechts);
vonLinks := vonLinks + 1;
vonRechts := vonRechts - 1;
end;
end;
Quicksort(Liste, erstes, vonRechts);
{li. und re. Teilfeld zerlegen}
Quicksort(Liste, vonLinks, letztes);
end;
end;
procedure TForm1.alleLinienClick(Sender: TObject);
begin
try
Output(length(Liste));
except ShowMessage('
Liste Leer');
end;
end;
procedure TForm1.bearbeitenClick(Sender: TObject);
var
MakierterEintrag:integer;
begin
try
MakierterEintrag:= ListBox1.ItemIndex;
//Makierter Eintrag wird in Editfelder eingetragen und gelöscht
Linie.Text:= Liste[MakierterEintrag].Linie;
Ziel.Text:= Liste[MakierterEintrag].Ziel;
Ankunft.Text:= TimeToStr(Liste[MakierterEintrag].Ankunft);
Abfahrt.Text:= TimeToStr(Liste[MakierterEintrag].Abfahrt);
Verspätung.Text:= TimeToStr(Liste[MakierterEintrag].Verspätung);
Delete;
except ShowMessage('
Liste Leer');
end;
end;
procedure TForm1.BeendenClick(Sender: TObject);
var
rec_p: PBusEintrag;
i: integer;
begin
i:=0;
while i<length(Liste)
do begin
rec_p:=Liste[i];
Dispose(rec_p);
i:= i+1;
end;
close;
end;
procedure TForm1.löschenClick(Sender: TObject);
begin
try
Delete;
Output(10);
except ShowMessage('
Liste Leer');
end;
end;
procedure TForm1.zehnAnzeigenClick(Sender: TObject);
begin
try
Output(10);
except ShowMessage('
Liste Leer');
end;
end;
procedure TForm1.HinzufügenClick(Sender: TObject);
begin
try
Add;
QuickSort(Liste,0,high(Liste));
Output(10);
//Edit Felder leeren
Linie.Clear;
Ziel.Clear;
Ankunft.Clear;
Abfahrt.Clear;
Verspätung.Clear;
//Falls etwas falsch eingegeben ist, Hinweis zeigen
except
showmessage
('
Bitte alle Felder ausfüllen oder korrekte Uhrzeit eingeben');
end;
end;
procedure TForm1.Add;
var
rec_p : PBusEintrag;
begin
new (rec_p);
if Verspätung.Text = '
'
then Verspätung.Text:= '
0';
//neuen Eintrag in Array eintragen
rec_p^.Linie:=Linie.Text;
rec_p^.Ziel:=Ziel.Text;
rec_p^.Ankunft:=Trunc(now) + StrToTime(Ankunft.Text);
//Wenn Abfahrt später als Ankunft, setzte Datum Heute
if StrToDateTime(Abfahrt.Text) > StrToDateTime(Ankunft.Text)
then
rec_p^.Abfahrt:=Trunc(now)+ StrToTime(Abfahrt.Text);
//Wenn Abfahrt früher als Ankunft, setze Datum Morgen
if StrToDateTime(Abfahrt.Text) < StrToDateTime(Ankunft.Text)
then
rec_p^.Abfahrt:=Trunc(now+1)+ StrToTime(Abfahrt.Text);
rec_p^.Verspätung:=StrToTime(Verspätung.Text);
//Array um 1 verlängern
SetLength(Liste, (length(Liste)+1));
//Bus an Liste anhängen
Liste[high(Liste)]:= rec_p;
end;
end.