AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Algorithmen, Datenstrukturen und Klassendesign Delphi Fertiges Programm, Fehlermeldung bei bestimmter Kombination

Fertiges Programm, Fehlermeldung bei bestimmter Kombination

Ein Thema von Marcel2906 · begonnen am 26. Aug 2011 · letzter Beitrag vom 26. Aug 2011
Antwort Antwort
Marcel2906

Registriert seit: 17. Aug 2011
Ort: Warendorf
112 Beiträge
 
Delphi 2010 Professional
 
#1

Fertiges Programm, Fehlermeldung bei bestimmter Kombination

  Alt 26. Aug 2011, 13:37
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.
Angehängte Dateien
Dateityp: zip Busanzeige Pointer.zip (836,7 KB, 5x aufgerufen)

Geändert von Marcel2906 (26. Aug 2011 um 14:07 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
40.509 Beiträge
 
Delphi 11 Alexandria
 
#2

AW: Fertiges Programm, Fehlermeldung bei bestimmter Kombination

  Alt 26. Aug 2011, 13:47
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)
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list

Geändert von himitsu (26. Aug 2011 um 13:55 Uhr)
  Mit Zitat antworten Zitat
Marcel2906

Registriert seit: 17. Aug 2011
Ort: Warendorf
112 Beiträge
 
Delphi 2010 Professional
 
#3

AW: Fertiges Programm, Fehlermeldung bei bestimmter Kombination

  Alt 26. Aug 2011, 14:07
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.
  Mit Zitat antworten Zitat
Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#4

AW: Fertiges Programm, Fehlermeldung bei bestimmter Kombination

  Alt 26. Aug 2011, 14:38
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)
Thomas Wassermann H₂♂
Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)
  Mit Zitat antworten Zitat
Bjoerk

Registriert seit: 28. Feb 2011
Ort: Mannheim
1.384 Beiträge
 
Delphi 10.4 Sydney
 
#5

AW: Fertiges Programm, Fehlermeldung bei bestimmter Kombination

  Alt 26. Aug 2011, 14:53
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.
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
40.509 Beiträge
 
Delphi 11 Alexandria
 
#6

AW: Fertiges Programm, Fehlermeldung bei bestimmter Kombination

  Alt 26. Aug 2011, 15:01
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.
  • 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



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
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list
  Mit Zitat antworten Zitat
Bjoerk

Registriert seit: 28. Feb 2011
Ort: Mannheim
1.384 Beiträge
 
Delphi 10.4 Sydney
 
#7

AW: Fertiges Programm, Fehlermeldung bei bestimmter Kombination

  Alt 26. Aug 2011, 18:42
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.

Geändert von Bjoerk (26. Aug 2011 um 19:19 Uhr) Grund: Inc(Index); ListBox1.Items.EndUpdate;
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 09:25 Uhr.
Powered by vBulletin® Copyright ©2000 - 2022, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf