Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Algorithmen, Datenstrukturen und Klassendesign (https://www.delphipraxis.net/78-algorithmen-datenstrukturen-und-klassendesign/)
-   -   Delphi Fertiges Programm, Fehlermeldung bei bestimmter Kombination (https://www.delphipraxis.net/162524-fertiges-programm-fehlermeldung-bei-bestimmter-kombination.html)

Marcel2906 26. Aug 2011 12:37


Fertiges Programm, Fehlermeldung bei bestimmter Kombination
 
Liste der Anhänge anzeigen (Anzahl: 1)
Nun habe ich mein Programm an sich fertig. Es ist eine Busanzeigetafel. Sprich man trägt in Edit Felder Die Linie, das Zeil, die Ankunftszeit, die Abfahrtszeit und die Verspätung ein. Dies wird dann im Array gespreichert und an ListBox ausgegeben. Wobei die Verspätung auf die Ankunft drauf gerechnet wird beim Ausgeben, falls die Verspätunf länger ist als die Pause (Zeit zwischen Anklunft und Abfahrt). Sortiert wird die Liste nach der Ankunftszeit + Verspätung.

Nun mein Problem:

Es kann immer nur eine Art von Bus geben. Also entweder sind haben alle eine Verspätung die kleiner ist als die Pause, oder alle haben eine Verspätung die größer ist als die Pause. Sobald 2 verschiedene hinzugefügt werden sollen, bricht das Programm ab. In Delphi kommt dann die Meldung:

Zitat:

Im Projekt Busanzeige.exe ist eine Exception der Klasse EStackOverflow mit der Meldung 'Stack-Überlauf' aufgetreten.
Ich weiß nicht, wo ich nach dem Fehler suchen soll. Bin schon per Hand die Befehle abgegangen, aber nichts gefunden. Sry dass ich jetzt den ganzen Code poste, aber ich weiß ja nicht wo ich suchen soll.

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;
    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.

himitsu 26. Aug 2011 12:47

AW: Fertiges Programm, Fehlermeldung bei bestimmter Kombination
 
Zitat:

Ich weiß nicht, wo ich nach dem Fehler suchen soll.
- Debugger anwerfen
- Fehler verursachen
- Im Debugger schauen wo es geknallt hat und sich dazu den Stacktrace anschauen (Menü>Ansicht>Degubfenster>Aufrufstack)


EurekaLog und Co. würden auch sehr gut bei Fehlersuchen/-analysen aushelfen.


Da du keine zugroßen lokalen Veriablen verwendest, gibt es nur zwei Gründe für diesen Fehler:
- eine Endlosschleife (rekursive Funktionsaufrufe)
- deine Zeigeroperationen verursachen einen Bufferoverrun, welcher zufällig den Stack beeinflußt


Zu Letzterem:
Jetzt rate mal, warum dir schon mehrmals gezeigt wurde, wie man hier die unnötigen Pointer vermeiden kann.
Weniger krittische/gefährliche Befehle = weniger potentielle Fehlerstellen.


PS:
Da hier der Rest des Programms fehlt, wird es auch keiner testen können ... wir haben nicht immer die Zeit uns ein Forumular zusammenzuklicken, nur weil das nicht beiliegt.
(Projekt in eine ZIP und anhängen)

Und ich glaub das mit dem Code-Tag wurde uch shconmal gesagt. (so sieht man doch nichts)
[DELPHI]der Delphi-Code[/DELPHI] (der Button mit dem roten Delphi-Helm)

Marcel2906 26. Aug 2011 13:07

AW: Fertiges Programm, Fehlermeldung bei bestimmter Kombination
 
Ich soll es aber mit Pointer machen, hat mein Ausbilder gesagt, zur Übung.
Nun zum Debugger. Den hab ich schon mal laufen lassen, aber damit kann ich den Fehler nicht darstellen, da ich keine 2 Busse eintragen kann, bzw. weiß nicht wie.

Bummi 26. Aug 2011 13:38

AW: Fertiges Programm, Fehlermeldung bei bestimmter Kombination
 
nach dem Löschen des letzen Elements knallt es hier:
Delphi-Quellcode:
      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)

Bjoerk 26. Aug 2011 13:53

AW: Fertiges Programm, Fehlermeldung bei bestimmter Kombination
 
Eine mögliche Fehlerquelle wäre auch der Quicksort. Dieser hat die häßliche Angewohnheit, bei gleichen Elementen einmal zu tauschen, das andere mal nicht, in deinem Falle bei 2 Bussen mit gleicher Ankunft+Verspätung.

Frag deinen Ausbilder mal, ob du wenigsten TList benutzen darfst.

himitsu 26. Aug 2011 14:01

AW: Fertiges Programm, Fehlermeldung bei bestimmter Kombination
 
Zitat:

Zitat von Marcel2906 (Beitrag 1119831)
Nun zum Debugger. Den hab ich schon mal laufen lassen, aber damit kann ich den Fehler nicht darstellen, da ich keine 2 Busse eintragen kann, bzw. weiß nicht wie.

Wieso denn nicht?
Ob das Progamm einzeln läuft oder in Delphi/Debugger ... du müßtest überall das Selbe eintragen können.


OK, zur Fehlersuche sollte man hier vieleicht noch so Einiges an Hilfsmitteln aktivieren.
  • Delphi-Quellcode:
    ReportMemoryLeaksOnShutdown := True;
    ... ist für die Speicherlecks, welche man bei solchem Code gerne mal erstellt.
    Am Bensten in der Projektdatei (DPR), aber man kann es auch irgendwo anders hinschreiben. (z.B. im OnCreate der Hauptform)
    Hauptsache es wird vor Programmende einmal gesetzt.
  • dann noch in den Projektoptionen die Bereichsprüfung aktivieren ... für die Arrayzugriffe, wo Delphi die Indize nun prüfen wird
  • und manchmal kann man auch mal die Überlaufprüfung, welche Überläufe bei Rechenoperationen (+-*/) prüft
    z.B.
    Delphi-Quellcode:
    var x: Cardinal
    x := 0;
    x := x - 1;
    ShowMessage(IntToStr(x));
    was ja eigentlich nicht geht, da in Cardinal keine negativen Werte reinpassen



Zitat:

Zitat von Marcel2906 (Beitrag 1119831)
Ich soll es aber mit Pointer machen, hat mein Ausbilder gesagt, zur Übung.

Hoffentlich nur zur Übung.
In einem Produktivcode sollte man dann natürlich "ordentlich" arbeiten :angle2:

Bjoerk 26. Aug 2011 17:42

AW: Fertiges Programm, Fehlermeldung bei bestimmter Kombination
 
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.


Alle Zeitangaben in WEZ +1. Es ist jetzt 02:03 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz