program KartonPacker;
uses SysUtils;
type Bestellung = Record
Menge:Integer;
Inhalt:Integer; // 0 für =0,75 und 1 für 1 LTR Flaschen
Artikel:String;
end;
TBestellung = Array [0..5] of Bestellung;
Var zahlen: TBestellung = ((Menge:9;Inhalt:1;Artikel:'A'), //Beispieldaten
(Menge:2;Inhalt:1;Artikel:'B'),
(Menge:1;Inhalt:0;Artikel:'C'),
(Menge:7;Inhalt:0;Artikel:'D'),
(Menge:3;Inhalt:0;Artikel:'F'),
(Menge:2;Inhalt:0;Artikel:'G'));
procedure GanzerKarton;
var
laenge,i,temp: Integer;
KAnzahl: Integer;
begin
laenge:=SizeOf(zahlen) div SizeOf(zahlen[0])-1;
for i:=0 to laenge-1 do
begin
KAnzahl:= zahlen[i].Menge div 6;
if KAnzahl>0 then
Writeln(KAnzahl,' voller Karton(s) von '+zahlen[i].Artikel);
zahlen[i].Menge:=zahlen[i].Menge mod 6;
end;
end;
procedure sortMenge;
var
laenge,i,j:Integer;
temp: Bestellung;
begin
laenge:=SizeOf(zahlen) div SizeOf(zahlen[0])-1;
for i:=0 to laenge-1 do
for j:=1 to laenge do
if zahlen[j-1].Menge > zahlen[j].Menge then
begin
temp:=zahlen[j-1];
zahlen[j-1]:=zahlen[j];
zahlen[j]:=temp;
end;
end;
procedure sortInhalt;
var
laenge,i,j:Integer;
temp: Bestellung;
begin
laenge:=SizeOf(zahlen) div SizeOf(zahlen[0])-1;
for i:=0 to laenge-1 do
for j:=1 to laenge do
if zahlen[j-1].Inhalt > zahlen[j].Inhalt then
begin
temp:=zahlen[j-1];
zahlen[j-1]:=zahlen[j];
zahlen[j]:=temp;
end;
end;
procedure Packen(z: TBestellung );
var laenge,i,p,k:Integer;
maxKarton:Integer;
KartonNr:Integer;
FlaschenType:Integer;
Kistevoll:boolean;
begin
laenge:=SizeOf(zahlen) div SizeOf(zahlen[0])-1; // Anzahl der Array Felder
maxKarton:=0;
KartonNr:=0;
Kistevoll:=False;
for i:=0 to laenge do inc(maxKarton,z[i].Menge);
maxKarton:=(maxKarton div 6) + 1;
P:=0; //Aktuelle Position in Array
while KartonNr<Maxkarton do
begin
k:=0; //KartonInhalt
Kistevoll:=False;
Inc(KartonNr);
Writeln('MischKarton ',KartonNr,' beinhaltet: ');
if z[p].Inhalt=0 then
begin
while ((z[p].menge<6) and (p<=laenge)) and (KisteVoll=False) and (z[p].Inhalt=0) do
begin
if (K+z[p].Menge<=6) then
begin
writeln(z[p].Menge,' ',z[p].Inhalt,' ',z[p].Artikel);
inc(k,z[p].Menge);
inc(p);
if k=6 then
begin
KisteVoll:=True;
k:=0;
end;
end else
begin
dec(z[p].Menge,6-k);
writeln(6-k,' ',z[p].Inhalt,' ',z[p].Artikel);
Kistevoll:=True;
k:=0;
end;
end;
end;
if z[p].Inhalt=1 then
begin
while ((z[p].menge<6) and (p<=laenge)) and (KisteVoll=False) and (z[p].Inhalt=1) do
begin
if K+z[p].Menge<=6 then
begin
writeln(z[p].Menge,' ',z[p].Inhalt,' ',z[p].Artikel);
inc(k,z[p].Menge);
inc(p);
if k=6 then
begin
KisteVoll:=True;
k:=0;
end;
end else
begin
dec(z[p].Menge,6-k);
writeln(6-k,' ',z[p].Inhalt,' ',z[p].Artikel);
Kistevoll:=True;
k:=0;
end;
end;
end;
end;
end;
procedure ausgabe(z: TBestellung );
var
i: Integer;
begin
for i:=0 to (SizeOf(zahlen) div SizeOf(zahlen[0]))-1 do
begin
write(z[i].Menge,' ',z[i].Inhalt,' ',z[i].Artikel);
writeln(',');
end;
end;
begin
GanzerKarton;
sortMenge;
sortInhalt;
Writeln('Sortiert:');
ausgabe(zahlen);
Packen(zahlen);
Writeln('Bitte Taste druecken...');Readln;
end.