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.