unit Busanzeige1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;
type
TBusEintrag = record
Linie: string;
Ziel: string;
Ankunft: TTime;
Abfahrt: TTime;
Verspätung: TTime;
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 Delete;
procedure Output(LängeListe:integer);
procedure Sort;
end;
Var
Form1 : TForm;
implementation
{$R *.dfm}
procedure TForm1.Delete;
var
MakierteStelle,i: integer;
rec : TBusEintrag;
rec_p : PBusEintrag;
begin
rec_p := Nil; // Init mit nichts
new (rec_p); // Init eines Speicherbereches der Größe TRec,
// und rec_P <> Nil und zeit eáuf eine Adresse
MakierteStelle:= 0;
//Makierte Stelle wird gesucht
for i := 0 to ListBox1.Count - 1 do
if ListBox1.Selected[i] then begin
MakierteStelle:=i;
end;
//Makierte Stelle komtm 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;
Dispose(rec_p);
rec_p := Nil;
end;
procedure TForm1.Output(LängeListe:integer);
const
MAX_TABS = 4;
Tab = #9;
var
Tabulators: array[0..MAX_TABS] of Integer;
StelleEintrag: integer;
rec : TBusEintrag;
rec_p : PBusEintrag;
begin
rec_p := Nil; // Init mit nichts
new (rec_p); // Init eines Speicherbereches der Größe TRec,
// und rec_P <> Nil und zeit eáuf eine Adresse
//Tabulatorweiten festlegen
Tabulators[0] := 72;
Tabulators[1] := 136;
Tabulators[2] := 202;
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, Abfahrt verändern
if Liste[StelleEintrag].Abfahrt-Liste[StelleEintrag].Ankunft<Liste[StelleEintrag].Verspätung then begin
while ((StelleEintrag < length(Liste)) and (StelleEintrag<LängeListe)) do begin
ListBox1.Items.Strings[StelleEintrag]:=
' '+Liste[StelleEintrag].Linie+ Tab +
Liste[StelleEintrag].Ziel+Tab+
(TimeToStr(Liste[StelleEintrag].Ankunft+Liste[StelleEintrag].Verspätung+(Liste[StelleEintrag].Verspätung-(Liste[StelleEintrag].Abfahrt-Liste[StelleEintrag].Ankunft))))+' 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, Abfahrt nicht verändern
while ((StelleEintrag < length(Liste)) and (StelleEintrag<LängeListe)) do begin
ListBox1.Items.Strings[StelleEintrag]:=
' '+Liste[StelleEintrag].Linie+ Tab +
Liste[StelleEintrag].Ziel+Tab+
TimeToStr(Liste[StelleEintrag].Abfahrt)+' Uhr'+Tab+
TimeToStr(Liste[StelleEintrag].Verspätung)+Tab+'h';
StelleEintrag:=StelleEintrag+1;
end;
Dispose(rec_p);
rec_p := Nil;
end;
procedure TForm1.Sort;
var
Eintrag,PositionImArray: integer;
AnkunftPlusVerspätung: TTime;
rec : TBusEintrag;
rec_p : PBusEintrag;
begin
rec_p := Nil; // Init mit nichts
new (rec_p); // Init eines Speicherbereches der Größe TRec,
// und rec_P <> Nil und zeit eáuf eine Adresse
PositionImArray:=0;
//Wenn Verspätung keine Eingabe hat, setzte Wert 0
if Verspätung.Text = '' then Verspätung.Text:= '0';
AnkunftPlusVerspätung:= (StrToTime(Ankunft.Text)+StrToTime(Verspätung.Text));
//Wenn Array länge 0 hat, Array um 1 verlängern
if length(Liste)=0 then begin
SetLength(Liste,1);
end
//suche Position für neuen Eintrag
else begin
while (AnkunftPlusVerspätung >(Liste[PositionImArray].Ankunft+Liste[PositionImArray].Verspätung)) and (PositionImArray < length(Liste)) do begin
PositionImArray:=(PositionImArray+1);
end;
//Array um 1 erweitern
SetLength(Liste,length(Liste)+1);
Eintrag:=(high(Liste));
//Einträge verschieben
while (Eintrag>PositionImArray) do begin
Liste[Eintrag]:=Liste[(Eintrag-1)];
Eintrag:=(Eintrag-1);
end;
end;
//neuen Eintrag in Array eintragen
Liste[PositionImArray].Linie:=Linie.Text;;
Liste[PositionImArray].Ziel:=Ziel.Text;
Liste[PositionImArray].Ankunft:=StrToTime(Ankunft.Text);
Liste[PositionImArray].Abfahrt:=StrToTime(Abfahrt.Text);
Liste[PositionImArray].Verspätung:=StrToTime(Verspätung.Text);
Dispose(rec_p);
rec_p := Nil;
end;
procedure TForm1.alleLinienClick(Sender: TObject);
var
rec : TBusEintrag;
rec_p : PBusEintrag;
begin
rec_p := Nil; // Init mit nichts
new (rec_p); // Init eines Speicherbereches der Größe TRec,
// und rec_P <> Nil und zeit eáuf eine Adresse
//ganze Liste in ListBox eintragen
Output(length(Liste));
Dispose(rec_p);
rec_p := Nil;
end;
procedure TForm1.bearbeitenClick(Sender: TObject);
var
i:integer;
MakierteStelle: integer;
rec : TBusEintrag;
rec_p : PBusEintrag;
begin
rec_p := Nil; // Init mit nichts
new (rec_p); // Init eines Speicherbereches der Größe TRec,
// und rec_P <> Nil und zeit eáuf eine Adresse
MakierteStelle:= 0;
//Makierte Stelle wird gesucht
for i := 0 to listbox1.Count - 1 do
if listbox1.Selected[i] then begin
MakierteStelle:=i;
end;
//Makierter Eintrag wird in Editfelder eingetragen und gelöscht
Linie.Text:= Liste[MakierteStelle].Linie;
Ziel.Text:= Liste[MakierteStelle].Ziel;
Ankunft.Text:= TimeToStr(Liste[MakierteStelle].Ankunft);
Abfahrt.Text:= TimeToStr(Liste[MakierteStelle].Abfahrt);
Verspätung.Text:= TimeToStr(Liste[MakierteStelle].Verspätung);
Delete;
Dispose(rec_p);
rec_p := Nil;
end;
procedure TForm1.BeendenClick(Sender: TObject);
var
rec : TBusEintrag;
rec_p : PBusEintrag;
begin
rec_p := Nil; // Init mit nichts
new (rec_p); // Init eines Speicherbereches der Größe TRec,
// und rec_P <> Nil und zeit eáuf eine Adresse
close;
Dispose(rec_p);
rec_p := Nil;
end;
procedure TForm1.löschenClick(Sender: TObject);
var
rec : TBusEintrag;
rec_p : PBusEintrag;
begin
rec_p := Nil; // Init mit nichts
new (rec_p); // Init eines Speicherbereches der Größe TRec,
// und rec_P <> Nil und zeit eáuf eine Adresse
Delete;
Output(10);
Dispose(rec_p);
rec_p := Nil;
end;
procedure TForm1.zehnAnzeigenClick(Sender: TObject);
begin
Output(10);
end;
procedure TForm1.HinzufügenClick(Sender: TObject);
begin
try
Sort;
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;
end.