Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi Probleme beim Queue und Pointer (https://www.delphipraxis.net/158959-probleme-beim-queue-und-pointer.html)

Swanator 9. Mär 2011 13:35

Delphi-Version: 6

Probleme beim Queue und Pointer
 
Hallo ihr,
ich brauch dringend Hilfe beim Queue! Ich komm einfach nicht weiter. Hab wohl ein Dankfehler. Sobald ich mehr als einen Eintrag mache kommt ein Fehler mit Speicheradresse. Wohl was mit dem Pointer.

Das ist die Aufgabe:

1. neue Schlange, danach können erst folgende Daten abgefragt werden:
-Name des Reisenden,
- jeder Koffer bekommt eine zufällige einmalige Nummer (1 – 999999),
-Gewicht des Koffer
Achtung: Überschreitet das Gewicht die 20 kg Grenze, erscheint eine entsprechende Meldung.
2. Jeder neue Kunde der die Reise beginnt, wird der Schlange hinzugefügt.
3. Jeder Kunde der fertig mit der Reise ist, wird aus der Schlange entfernt.
4. Es wird die komplette Liste in der richtigen Reihenfolge (erstes Element der Schlange steht am
Anfang, letztes Element der Schlange steht am Ende der Anzeige) in einer geeigneten Komponente
angezeigt.
5. Die Liste wird gespeichert, um sie z. B. an einem anderen Schalter oder beim Zoll zur Verfügung zu
haben und entsprechend wieder geladen. Der Speichername ist frei wählbar.
6. Es werden Koffer der Kunden mitten aus der Schlange vorübergehend entfernt mit
-zufälliger Nummer: Der Zoll macht zufällige Kontrolle bzw.
-konkreter Nummer: Der Zoll hat einen begründeten Verdacht und nach der Kontrolle wieder am Ende der Schlange eingefügt.

> 6. mit zufälliger Nr. hab ich schon, ist hier nur nicht mit dabei.
> Das Suchfenster war nur ne Idee, werd wohl sowieso nicht mehr zur Einarbeitung kommen.
> Wenn ihr mir da helfen könntet, wär das echt top. Wir haben dafür nur noch 2 Stunden und ich hab weder einen Plan noch Delphi zu Hause.


Quelltext:
Delphi-Quellcode:
unit U_Kofferschlange_a4;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, UnitQueue, UInhalt, Grids;

type
  TForm1 = class(TForm)
    b_new: TButton;
    b_delite: TButton;
    b_edit: TButton;
    e_name: TEdit;
    e_wight: TEdit;
    l_name: TLabel;
    r_male: TRadioButton;
    r_female: TRadioButton;
    l_wight: TLabel;
    b_close: TButton;
    S_out: TStringGrid;
    b_actual: TButton;
    e_savename: TEdit;
    b_save: TButton;
    b_load: TButton;
    l_warning: TLabel;
    procedure b_newClick(Sender: TObject);
    procedure b_editClick(Sender: TObject);
    procedure b_deliteClick(Sender: TObject);
    procedure b_actualClick(Sender: TObject);
    procedure b_saveClick(Sender: TObject);
    procedure b_loadClick(Sender: TObject);
    procedure b_closeClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  Q: TQ;
  inhalt:tInhalt;
  //name: string;
 nr,l:integer;

implementation

{$R *.dfm}

procedure TForm1.b_newClick(Sender: TObject);
begin
init(Q);
l:=0;
end;

procedure neu;
begin
nr:=random(99999)+1;
Q.aktuell:=Q.anfang;
while not(q.aktuell=nil) and not(Inhalt.Koffernummer=nr)
Do Q.aktuell:=Q.aktuell.next;
if not (q.aktuell=nil)
        then neu;
end;


procedure TForm1.b_editClick(Sender: TObject);
begin
neu;
Inhalt.Name:=e_name.Text;
Inhalt.Koffergewicht:=strtoint(e_wight.Text);
Inhalt.Koffernummer:=nr;
put(Q,Inhalt);
l:=l+1;
s_out.Cells[0,l]:=q.aktuell.inhalt.Name;
s_out.Cells[1,l]:=inttostr(Q.aktuell.inhalt.Koffergewicht);
s_out.Cells[2,l]:=inttostr(Q.aktuell.inhalt.Koffernummer);
if strtoint(e_wight.Text)>20
        then l_warning.Caption:='Warnung: Das Gewicht ¸berschreitet die zul‰ssigen 20kg Freigep‰ck!';
end;

procedure TForm1.b_deliteClick(Sender: TObject);
begin
get(Q,inhalt);
end;

procedure TForm1.b_actualClick(Sender: TObject);
begin
IF not empty(Q) then begin
        Q.aktuell:=Q.anfang;
        repeat q.aktuell:=q.aktuell.next
        until Q.aktuell.next=nil;
        If Q.aktuell.inhalt.Koffergewicht>20
                then l_warning.Caption:='Warnung: Das Gewicht ¸berschreitet die zul‰ssigen 20kg Freigep‰ck!';

end;
end;

procedure TForm1.b_saveClick(Sender: TObject);
begin
Save(Q,e_savename.Text);
end;

procedure TForm1.b_loadClick(Sender: TObject);
begin
Load(Q,e_savename.Text);
end;

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

end.



unit UListe;



interface
uses   UInhalt;
type   PZeiger = ^TElement;
        TElement = record
                     next : PZeiger;
                     inhalt: TInhalt;
                   end;
         TListe = record
                    anfang,aktuell : PZeiger;
                    anzahl:integer;
                  end;
procedure Erzeuge(var Liste:TListe);
procedure FuegeEinVor(var Liste:TListe; inh : TInhalt);
procedure FuegeEinNach(var Liste:TListe; inh : TInhalt);
procedure Aendere(var Liste:TListe; Inh:TInhalt);
procedure Loesche(var Liste:TListe);
procedure Lies(Liste:TListe;var Inh:TInhalt);
procedure FindeErstes(var Liste:TListe);
procedure FindeNaechstes(var Liste:TListe);
function Leer(Liste:TListe):boolean;
function Voll(Liste:TListe):boolean;
function ElementZahl(Liste:TListe):integer;
function Letztes(Liste:TListe):boolean;
procedure Speichere(Liste:TListe;NameDerDatei:String);
procedure Lade(var Liste:TListe;NameDerDatei:String);
procedure Sort(Liste:TListe);



implementation
procedure Speichere(Liste:TListe;NameDerDatei:String);
type TDatei=File of TInhalt;
var  Datei:TDatei;
begin
  assignfile(Datei,'C:\Projekt\save\'+NameDerDatei+'.dat');
  rewrite(datei);
  Liste.aktuell:=Liste.anfang;
  repeat
   write(datei,Liste.aktuell^.inhalt);
   Liste.aktuell:= Liste.aktuell^.next;
  until  Liste.aktuell^.next=nil;
   write(datei,Liste.aktuell^.inhalt);
  closefile(datei);
end;

procedure Lade(var Liste:TListe;NameDerDatei:String);
type TDatei=File of TInhalt;
var  Datei:TDatei;
      neu : PZeiger;
begin
  assignfile(Datei,'C:\Projekt\save\'+NameDerDatei+'.dat');
  reset(datei);
  new(Liste.Anfang);
  read(datei,Liste.Anfang^.inhalt);
  Liste.Aktuell:=Liste.Anfang;
  Liste.Aktuell^.next:=nil;
  while not eof(datei) do
     begin
      new(Neu);
      read(datei,Neu^.inhalt);
      Neu^.next:=nil;
      Liste.Aktuell^.next:=Neu;
      Liste.Aktuell:=Neu;
    end;
   closefile(datei);
end;


function Leer(Liste:TListe):boolean;
begin
 Leer:= Liste.anfang = nil;
end;

function Voll(Liste:TListe):boolean;
begin
 Voll:= false;
// Voll:= SizeOf(TElement) > MemAvail;
end;

function ElementZahl(Liste:TListe):integer;
begin
  ElementZahl := Liste.anzahl;
end;

function Letztes(Liste:TListe):boolean;
begin
 Letztes:= Liste.aktuell^.next = nil;
end;

procedure FindeErstes(var Liste:TListe);
begin
 Liste.aktuell:= Liste.anfang ;
end;

procedure FindeNaechstes(var Liste:TListe);
begin
 Liste.aktuell:= Liste.aktuell^.next ;
end;

procedure Erzeuge(var Liste:TListe);
begin
  Liste.anfang := nil;
  Liste.aktuell := nil;
  Liste.anzahl := 0;
end;

procedure FuegeEinNach(var Liste:TListe; inh : TInhalt);
var neu: PZeiger;
begin
  new(neu);
  neu^.inhalt:=inh;
      if Leer(Liste) then
                       begin
                         Liste.anfang:=neu;
                         neu^.next:= nil;
                       end
                      else
                        begin
                          neu^.next:=Liste.aktuell^.next;
                          Liste.aktuell^.next:=neu;
                        end;
      Liste.aktuell :=neu;
      Liste.anzahl:=Liste.anzahl+1;

end;

procedure FuegeEinVor(var Liste:TListe; inh : TInhalt);
var neu,lauf: PZeiger;
begin
  new(neu);
  neu^.inhalt:=inh;
      if Liste.aktuell=Liste.anfang then
                          Liste.anfang:=neu
                        else
                          begin
                            lauf := Liste.anfang;
                            while lauf^.next <> Liste.aktuell do lauf:=lauf^.next;
                            lauf^.next:=neu;
                          end;
        neu^.next:=Liste.aktuell;
        Liste.aktuell:=neu;
       Liste.anzahl:=Liste.anzahl+1;
end;

procedure Loesche(var Liste:TListe);
var lauf: PZeiger;
begin
      if Liste.aktuell=Liste.anfang then
                          Liste.anfang:=Liste.anfang^.next
                        else
                          begin
                            lauf := Liste.anfang;
                            while lauf^.next <> Liste.aktuell do lauf:=lauf^.next;
                            lauf^.next:=Liste.aktuell^.next;
                          end;
        dispose(Liste.aktuell);
        Liste.aktuell:=Liste.anfang;
       Liste.anzahl:=Liste.anzahl-1;

end;

procedure Aendere(VAR Liste:TListe; Inh:TInhalt);
begin
 Liste.aktuell^.inhalt:= inh ;
end;

procedure Lies(Liste:TListe;var Inh:TInhalt);
begin
  inh := Liste.aktuell^.inhalt;
end;


procedure Sort(Liste:TListe);
{var tausch:boolean;
i:integer;
inh,inhNachbar:TInhalt; }
begin
{tausch:=true;
while tausch do
begin
tausch:=false;
findeErstes(Liste);
for i:=1 to (Liste.anzahl)-1 do
begin
lies(Liste,inh);
inhNachbar:=Liste.Aktuell^.next^.Inhalt;
if inh.begriff>inhNachbar.begriff
then
begin
aendere(Liste,inhNachbar);
findeNaechstes(Liste);
aendere(Liste,inh);
tausch:=true
end
else
findeNaechstes(Liste);
end;
end;}
end;
end.




program P_Kofferschlange_a4;

uses
  Forms,
  U_Kofferschlange_a4 in 'U_Kofferschlange_a4.pas' {Form1},
  U_Suchfenster_a4 in 'U_Suchfenster_a4.pas' {Frame1: TFrame};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.


unit U_Suchfenster_a4;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, U_Kofferschlange_a4;

type
  TFrame1 = class(TFrame)
    e_koffernummer: TEdit;
    r_spezial: TRadioButton;
    r_zufall: TRadioButton;
    b_seach: TButton;
    procedure b_seachClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

implementation

{$R *.dfm}

procedure TFrame1.b_seachClick(Sender: TObject);
begin
Q.aktuell:=Q.anfang;

end;

end.


unit UInhalt;

interface


 type TBegriff=string[30];
       TErklaerung= string[200];
       //TInhalt=string[10];
       TInhalt = record
        Name: string[30];
        Koffergewicht: integer;
        Koffernummer: integer;
        end;
implementation

end.


unit UListe;

interface
uses   UInhalt;
type   PZeiger = ^TElement;
        TElement = record
                     next : PZeiger;
                     inhalt: TInhalt;
                   end;
         TListe = record
                    anfang,aktuell : PZeiger;
                    anzahl:integer;
                  end;
procedure Erzeuge(var Liste:TListe);
procedure FuegeEinVor(var Liste:TListe; inh : TInhalt);
procedure FuegeEinNach(var Liste:TListe; inh : TInhalt);
procedure Aendere(var Liste:TListe; Inh:TInhalt);
procedure Loesche(var Liste:TListe);
procedure Lies(Liste:TListe;var Inh:TInhalt);
procedure FindeErstes(var Liste:TListe);
procedure FindeNaechstes(var Liste:TListe);
function Leer(Liste:TListe):boolean;
function Voll(Liste:TListe):boolean;
function ElementZahl(Liste:TListe):integer;
function Letztes(Liste:TListe):boolean;
procedure Speichere(Liste:TListe;NameDerDatei:String);
procedure Lade(var Liste:TListe;NameDerDatei:String);
procedure Sort(Liste:TListe);



implementation
procedure Speichere(Liste:TListe;NameDerDatei:String);
type TDatei=File of TInhalt;
var  Datei:TDatei;
begin
  assignfile(Datei,'H:\Behrendt_LK1\k11a4\LK13_2_Inf\liste_begriffe\save\'+NameDerDatei+'.dat');
  rewrite(datei);
  Liste.aktuell:=Liste.anfang;
  repeat
   write(datei,Liste.aktuell^.inhalt);
   Liste.aktuell:= Liste.aktuell^.next;
  until  Liste.aktuell^.next=nil;
   write(datei,Liste.aktuell^.inhalt);
  closefile(datei);
end;

procedure Lade(var Liste:TListe;NameDerDatei:String);
type TDatei=File of TInhalt;
var  Datei:TDatei;
      neu : PZeiger;
begin
  assignfile(Datei,'H:\Behrendt_LK1\k11a4\LK13_2_Inf\liste_begriffe\save\'+NameDerDatei+'.dat');
  reset(datei);
  new(Liste.Anfang);
  read(datei,Liste.Anfang^.inhalt);
  Liste.Aktuell:=Liste.Anfang;
  Liste.Aktuell^.next:=nil;
  while not eof(datei) do
     begin
      new(Neu);
      read(datei,Neu^.inhalt);
      Neu^.next:=nil;
      Liste.Aktuell^.next:=Neu;
      Liste.Aktuell:=Neu;
    end;
   closefile(datei);
end;


function Leer(Liste:TListe):boolean;
begin
 Leer:= Liste.anfang = nil;
end;

function Voll(Liste:TListe):boolean;
begin
 Voll:= false;
// Voll:= SizeOf(TElement) > MemAvail;
end;

function ElementZahl(Liste:TListe):integer;
begin
  ElementZahl := Liste.anzahl;
end;

function Letztes(Liste:TListe):boolean;
begin
 Letztes:= Liste.aktuell^.next = nil;
end;

procedure FindeErstes(var Liste:TListe);
begin
 Liste.aktuell:= Liste.anfang ;
end;

procedure FindeNaechstes(var Liste:TListe);
begin
 Liste.aktuell:= Liste.aktuell^.next ;
end;

procedure Erzeuge(var Liste:TListe);
begin
  Liste.anfang := nil;
  Liste.aktuell := nil;
  Liste.anzahl := 0;
end;

procedure FuegeEinNach(var Liste:TListe; inh : TInhalt);
var neu: PZeiger;
begin
  new(neu);
  neu^.inhalt:=inh;
      if Leer(Liste) then
                       begin
                         Liste.anfang:=neu;
                         neu^.next:= nil;
                       end
                      else
                        begin
                          neu^.next:=Liste.aktuell^.next;
                          Liste.aktuell^.next:=neu;
                        end;
      Liste.aktuell :=neu;
      Liste.anzahl:=Liste.anzahl+1;

end;

procedure FuegeEinVor(var Liste:TListe; inh : TInhalt);
var neu,lauf: PZeiger;
begin
  new(neu);
  neu^.inhalt:=inh;
      if Liste.aktuell=Liste.anfang then
                          Liste.anfang:=neu
                        else
                          begin
                            lauf := Liste.anfang;
                            while lauf^.next <> Liste.aktuell do lauf:=lauf^.next;
                            lauf^.next:=neu;
                          end;
        neu^.next:=Liste.aktuell;
        Liste.aktuell:=neu;
       Liste.anzahl:=Liste.anzahl+1;
end;

procedure Loesche(var Liste:TListe);
var lauf: PZeiger;
begin
      if Liste.aktuell=Liste.anfang then
                          Liste.anfang:=Liste.anfang^.next
                        else
                          begin
                            lauf := Liste.anfang;
                            while lauf^.next <> Liste.aktuell do lauf:=lauf^.next;
                            lauf^.next:=Liste.aktuell^.next;
                          end;
        dispose(Liste.aktuell);
        Liste.aktuell:=Liste.anfang;
       Liste.anzahl:=Liste.anzahl-1;

end;

procedure Aendere(VAR Liste:TListe; Inh:TInhalt);
begin
 Liste.aktuell^.inhalt:= inh ;
end;

procedure Lies(Liste:TListe;var Inh:TInhalt);
begin
  inh := Liste.aktuell^.inhalt;
end;


procedure Sort(Liste:TListe);
{var tausch:boolean;
i:integer;
inh,inhNachbar:TInhalt; }
begin
{tausch:=true;
while tausch do
begin
tausch:=false;
findeErstes(Liste);
for i:=1 to (Liste.anzahl)-1 do
begin
lies(Liste,inh);
inhNachbar:=Liste.Aktuell^.next^.Inhalt;
if inh.begriff>inhNachbar.begriff
then
begin
aendere(Liste,inhNachbar);
findeNaechstes(Liste);
aendere(Liste,inh);
tausch:=true
end
else
findeNaechstes(Liste);
end;
end;}
end;
end.




unit UnitQueue;

interface

uses Uinhalt,Uliste;

type
        TQ=TListe;
        procedure init(var Q:TQ);
        procedure put(var Q:TQ; Inh:Tinhalt);
        procedure get(var Q:TQ; var inh:Tinhalt);
        function count(Q:TQ):integer;
        function empty(Q:TQ):Boolean;
        procedure save(Q:Tq; savename:string);
        procedure load(Q:Tq; savename:string);

implementation
procedure init(var Q:TQ);
begin
        erzeuge(Q);
end;

procedure put(var Q:Tq; Inh:Tinhalt);
begin
        if leer(Q)
                then FuegeEInNach(Q,Inh)
                else begin
                        while not letztes(Q) do
                          FindeNaechstes(Q);
                        FuegeEinNach(Q,inh);
                        end
end;

procedure get(var Q:Tq; var inh:Tinhalt);
begin
 findeerstes(Q);
 lies(Q,Inh);
 loesche(Q);
end;

procedure save(Q:Tq;savename:string);
begin
Speichere(Q,savename);
end;

procedure load (Q:Tq;savename:string);
begin
Lade(Q,savename);
end;

function count(Q:Tq):integer;
begin
        count:=ElementZahl(Q);
end;

function empty(Q:Tq):Boolean;
begin
        empty:=leer(Q);
end;
end.

patti 9. Mär 2011 13:40

AW: Probleme beim Queue und Pointer
 
Herzlich Willkommen in der DP!

Bitte nutze für deinen Quelltext die Code-Tags des Forums ([ CODE]...[ /CODE], ohne die Leerzeichen), da man sonst den Quelltext nur äußerst schwer lesen kann. Bei der Länge des Quelltextes würde es sich auch anbieten, ihn als Anhang an deinen Beitrag anzuhängen. Du kannst deinen Beitrag oben ganz einfach editieren ;-)

Danke

mkinzler 9. Mär 2011 14:08

AW: Probleme beim Queue und Pointer
 
Zitat:

Zitat von patti (Beitrag 1087009)
Herzlich Willkommen in der DP!

Bitte nutze für deinen Quelltext die Code-Tags des Forums ([ CODE]...[ /CODE], ohne die Leerzeichen), da man sonst den Quelltext nur äußerst schwer lesen kann. Bei der Länge des Quelltextes würde es sich auch anbieten, ihn als Anhang an deinen Beitrag anzuhängen. Du kannst deinen Beitrag oben ganz einfach editieren ;-)

Danke

Noch besser den Delphi-Tag.

Habe ich diesmal aber erledigt.

Zitat:

Hab wohl ein Dankfehler.
Das machen die Meisten falsch. :mrgreen:

patti 9. Mär 2011 14:16

AW: Probleme beim Queue und Pointer
 
Zitat:

Zitat von mkinzler (Beitrag 1087016)
Noch besser den Delphi-Tag.

Mein ich doch :stupid:

DeddyH 9. Mär 2011 17:39

AW: Probleme beim Queue und Pointer
 
[OT] Wo lernt man eigentlich so "kreative" Einrückungen ohne Sinn und Verstand? [/OT]

shmia 9. Mär 2011 17:45

AW: Probleme beim Queue und Pointer
 
Zitat:

Zitat von DeddyH (Beitrag 1087078)
[OT] Wo lernt man eigentlich so "kreative" Einrückungen ohne Sinn und Verstand? [/OT]

[OT^2]Das war bestimmt keine Absicht. Die Zeilen wurden halt irgendwoher geguttenbergt.[/OT^2] :-D

patti 9. Mär 2011 18:34

AW: Probleme beim Queue und Pointer
 
[OT^3]
Ein Hoch auf Python, da lernt man wenigstens noch das richtige Einrücken :stupid:
[/OT^3]

Bjoerk 9. Mär 2011 19:21

AW: Probleme beim Queue und Pointer
 
Zitat:

Wenn ihr mir da helfen könntet, wär das echt top. Wir haben dafür nur noch 2 Stunden und ich hab weder einen Plan noch Delphi zu Hause.
[OT^4] :-D Kann mir jemand mal schnell 100 Euro leihen, ich hab' grad keine Geld und kein Freundin... [/OT^4]


Alle Zeitangaben in WEZ +1. Es ist jetzt 20:30 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