![]() |
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:
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. |
AW: Fertiges Programm, Fehlermeldung bei bestimmter Kombination
Zitat:
- 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) |
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. |
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) |
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. |
AW: Fertiges Programm, Fehlermeldung bei bestimmter Kombination
Zitat:
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.
Zitat:
In einem Produktivcode sollte man dann natürlich "ordentlich" arbeiten :angle2: |
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 08:12 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz