Fertiges Programm, Fehlermeldung bei bestimmter Kombination

[Bjoerk]

Hallo Marcel,

Ich habe mir deinen Code mal näher angeschaut und überarbeitet. Des weiteren habe ich einen SpeichernButton anlog dem HinzufügenButton eingefügt, denn das mit dem Delete war Nonsens, und die Umlaute entfernt (gehen bei mir in D 2007 nicht). Der Code besitzt nun ein Object TBusListe, auf das bequem zugegriffen werden kann.

Bitte überprüfen!

Delphi-Quellcode:

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; 
    Verspaetung: TDateTime; 
  end; 
  PBusEintrag = ^TBusEintrag; 

  TBusListe = class (TObject)
    Items: array of PBusEintrag; 
    function GetItem (const I: integer): TBusEintrag; 
    procedure AddItem (const T: TBusEintrag); 
    procedure InsItem (const I: integer; const T: TBusEintrag); 
    procedure DelItem (const I: integer); 
    procedure SetItem (const I: integer; const T: TBusEintrag); 
    procedure ExChange (const I, J: integer); 
    function Count: integer; 
  public
    destructor Destroy; override; 
  end; 

  TForm1 = class(TForm)
    ListBox1: TListBox; 
    TLabel1: TLabel; 
    TLabel2: TLabel; 
    TLabel3: TLabel; 
    TLabel4: TLabel; 
    TLabel5: TLabel; 
    Hinzufuegen: TButton; 
    alleLinien: TButton; 
    Linie: TEdit; 
    Ziel: TEdit; 
    Ankunft: TEdit; 
    Abfahrt: TEdit;
    Verspaetung: TEdit; 
    Label1: TLabel; 
    Label2: TLabel; 
    Label3: TLabel; 
    bearbeiten: TButton; 
    loeschen: TButton; 
    zehnAnzeigen: TButton; 
    Label4: TLabel; 
    Label5: TLabel; 
    Label6: TLabel; 
    Label7: TLabel; 
    Beenden: TBitBtn; 
    Speichern: TButton;
    procedure BeendenClick(Sender: TObject); 
    procedure alleLinienClick(Sender: TObject); 
    procedure zehnAnzeigenClick(Sender: TObject); 
    procedure bearbeitenClick(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure HinzufuegenClick(Sender: TObject); 
    procedure SpeichernClick(Sender: TObject); 
    function GetInput: TBusEintrag; 
    procedure loeschenClick(Sender: TObject);
 private
   procedure Output(const Count: integer); 
   procedure Sort; 
 end; 

var
  Form1: TForm; 

implementation

{$R *.dfm}

var
  BusListe: TBusListe; 


function TBusListe.Count: integer; 
begin
  Result:= Length(Items); 
end;


function TBusListe.GetItem (const I: integer): TBusEintrag;
begin
  Result:= Items[I]^;
end;


procedure TBusListe.SetItem (const I: integer; const T: TBusEintrag);
begin
  Items[I]^:= T;
end;


procedure TBusListe.AddItem (const T: TBusEintrag);
var
  P: PBusEintrag;
begin
  SetLength(Items, Count+1);
  New(P);
  P^:= T;
  Items[Count-1]:= P;
end;


procedure TBusListe.InsItem (const I: integer; const T: TBusEintrag);
var
  J: integer;
  Temp: TBusEintrag;
begin
  AddItem(Temp);
  for J:= Count-1 downto I+1 do
  begin
    Temp:= GetItem(J-1);
    SetItem(J, Temp);
  end;
  SetItem(I, T);
end;


procedure TBusListe.DelItem (const I: integer);
var
  J: integer;
  P: PBusEintrag;
  Temp: TBusEintrag;
begin
  for J:= I to Count-2 do
  begin
    Temp:= GetItem(J+1);
    SetItem(J, Temp);
  end;
  P:= Items[Count-1];
  Dispose(P);
  SetLength(Items, Count-1);
end;


procedure TBusListe.ExChange (const I, J: integer);
var
  T1, T2: TBusEintrag;
begin
  T1:= GetItem(I);
  T2:= GetItem(J);
  SetItem(I, T2);
  SetItem(J, T1);
end;


destructor TBusListe.Destroy;
begin
  while Count > 0 do DelItem(Count-1);
  inherited Destroy;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  BusListe:= TBusListe.Create;
end;


procedure TForm1.FormDestroy(Sender: TObject);
begin
  BusListe.Free;
end;


procedure TForm1.Sort;
var
  T1, T2: TBusEintrag; 
  I, J: integer; 
begin                 
  for I:= 0 to BusListe.Count-2 do
    for J:= I+1 to BusListe.Count-1 do
    begin
      T1:= BusListe.GetItem(I); 
      T2:= BusListe.GetItem(J); 
      if (T1.Ankunft+T1.Verspaetung) > (T2.Ankunft+T2.Verspaetung) then
        BusListe.ExChange(I, J); 
    end; 
end; 


function TForm1.GetInput: TBusEintrag; 
begin
  if Trim(Verspaetung.Text) = '' then Verspaetung.Text:= '0'; 

  Result.Linie:= Linie.Text; 
  Result.Ziel:= Ziel.Text; 

  Result.Ankunft:= Trunc(Now)+ StrToTime(Ankunft.Text); 

  //Wenn Abfahrt später als Ankunft, setzte Datum Heute
  if StrToDateTime(Abfahrt.Text) >= StrToDateTime(Ankunft.Text) then
    Result.Abfahrt:= Trunc(Now)+StrToTime(Abfahrt.Text);

  //Wenn Abfahrt früher als Ankunft, setze Datum Morgen
  if StrToDateTime(Abfahrt.Text) < StrToDateTime(Ankunft.Text) then
    Result.Abfahrt:= Trunc(Now+1)+StrToTime(Abfahrt.Text);

  Result.Verspaetung:= StrToTime(Verspaetung.Text);
end;


procedure TForm1.bearbeitenClick(Sender: TObject);
var
  I: integer;
  T: TBusEintrag;
begin
  I:= ListBox1.ItemIndex;
  if (I > -1) and (I < BusListe.Count) then
  begin
    T:= BusListe.GetItem(I);
    Linie.Text:= T.Linie;
    Ziel.Text:= T.Ziel;
    Ankunft.Text:= TimeToStr(T.Ankunft);
    Abfahrt.Text:= TimeToStr(T.Abfahrt);
    Verspaetung.Text:= TimeToStr(T.Verspaetung);
  end
  else
    ShowMessage('Liste Leer oder kein Eintrag ausgewählt');
end;


procedure TForm1.zehnAnzeigenClick(Sender: TObject);
begin
  Output(10);
end;


procedure TForm1.alleLinienClick(Sender: TObject);
begin
  Output(BusListe.Count);
end;


procedure TForm1.SpeichernClick(Sender: TObject);
var
  I: integer;
  T: TBusEintrag;
begin
  I:= ListBox1.ItemIndex;
  if (I > -1) and (I < BusListe.Count) then
  begin
    T:= GetInput;
    try
      BusListe.SetItem(I, T);
      Sort;
      Output(10);
      // Linie.Clear;
      // Ziel.Clear;
      // Ankunft.Clear;
      // Abfahrt.Clear;
      // Verspaetung.Clear;
    except
      ShowMessage('Bitte alle Felder und bitte korrekt ausfüllen');
    end;
  end;
end;


procedure TForm1.HinzufuegenClick(Sender: TObject);
var
  T: TBusEintrag;
begin
  T:= GetInput;
  try
    BusListe.AddItem(T);
    Sort;
    Output(10);
    // Linie.Clear;
    // Ziel.Clear;
    // Ankunft.Clear;
    // Abfahrt.Clear;
    // Verspaetung.Clear;
  except
    ShowMessage('Bitte alle Felder und bitte korrekt ausfüllen');
  end;
end;


procedure TForm1.loeschenClick(Sender: TObject);
var
  I: integer;
begin
  I:= ListBox1.ItemIndex;
  if (I > -1) and (I < BusListe.Count) then
  begin
    BusListe.DelItem(I);
    ListBox1.DeleteSelected;
  end;
  Output(10);
end;


procedure TForm1.BeendenClick(Sender: TObject);
begin
  close;
end;


procedure TForm1.Output(const Count: integer);
const
  Max_TABS = 4;
  Tab = #9;
var
  Tabulators: array[0..Max_TABS] of integer;
  Index: integer;
  T: TBusEintrag;
begin
  //Tabulatorweiten festlegen
  Tabulators[0]:= 30;
  Tabulators[1]:= 100;
  Tabulators[2]:= 200;
  Tabulators[3]:= 1;
  Tabulators[4]:= 1;
  ListBox1.TabWidth:= 1;

  //Tabulatoren setzen
  SendMessage(ListBox1.Handle, LB_SETTABSTopS, Max_TABS, longInt(@Tabulators));

  //ListBox leeren
  ListBox1.Items.Clear;
  ListBox1.Items.BeginUpdate;

  //BusListe ausgeben
  Index:= 0;
  while (Index < Count) and (Index < BusListe.Count) do
  begin
    T:= BusListe.GetItem(Index);

    //Wenn Verspätung größer als Pause zwischen Ankunft und Abfahrt,
    //dann Abfahrt verändern
    if Frac(T.Abfahrt-T.Ankunft) < Frac(T.Verspaetung) then
      ListBox1.Items.Add(' '+T.Linie+ Tab +
                         T.Ziel+Tab+(DateTimeToStr(T.Ankunft+
                         Frac(T.Verspaetung)))+
                         ' Uhr'+Tab+
                         TimeToStr(T.Verspaetung)+Tab+'h')
    else
      //Wenn Verspätung kleiner als Pause zwischen Ankunft und Abfahrt,
      //dann Abfahrt nicht verändern
      ListBox1.Items.Add(' '+T.Linie+ Tab +
                         T.Ziel+Tab+
                         DateTimeToStr(T.Abfahrt)+' Uhr'+Tab+
                         TimeToStr(T.Verspaetung)+Tab+'h');
    Inc (Index);
  end;
  ListBox1.Items.EndUpdate;
end;

end.