Translate

Program Stack (Tumpukan) Menggunakan Sorting & Searching

Posted: Minggu, 08 Mei 2011 by Ajiex Estrada in Labels:
0

uses crt;
label awal;
const max = 25;

type stack = record
a,b,c,d : array [1..7] of string;
top : 0..max;
end;
recdata = record
nm,jn,al : string;
jm,hr : string;
end;
lar = array[1..max] of recdata;
var
s : stack;
data : lar;
i,n,k,s1,s2 : integer;
j,p,seri : char;

procedure push (var s : stack; x :recdata);
begin
if s.top = max then
begin
gotoxy(20,20);writeln ('LOUNDRY PENUH DAB..!!!!!!');
gotoxy(20,21);writeln ('PRESS ENTER KEY GOTO MENU');
end
else
begin
s.top := s.top + 1;
s.a[s.top] := x.nm;
s.b[s.top] := x.al;
s.c[s.top] := x.jn;
s.d[s.top] := x.jm;

end;
end;

procedure input(var x:lar);
begin
clrscr;
j := 'y';
while j = 'y' do
begin
n:= n+1;
writeln ('Pelanggan ke->',n);
write ('Nama Pelanggan : ');readln(data[n].nm);
write ('Alamat : ');readln(data[n].al);
write ('Jenis Cucian : ');readln(data[n].jn);
write ('Jumlah Cucian : ');readln(data[n].jm);
push(s,data[n]);
writeln;
write ('tambah pelanggan[y/n]');readln(j);
writeln;
end;
end;

procedure pop(var s : stack);
begin
s.top := s.top - 1;
n := n - 1;
end;

procedure ambil;
begin
clrscr;
if s.top = 0 then
begin
gotoxy(20,20);writeln ('LOUNDRY KOSONG DAB..!!!!!');
gotoxy(20,21);writeln ('PRESS ENTER KEY GOTO MENU');
readln;
end
else
begin
pop(s);
gotoxy(20,20);writeln ('BERHASIL..!!!!!');
gotoxy(20,21);writeln ('PRESS ENTER KEY GOTO MENU');
readln;
end
end;
procedure look(var x : lar);
begin

if s.top = 0 then
begin
gotoxy(20,20);writeln ('LOUNDRY KOSONG');
gotoxy(20,21);writeln ('PRESS ENTER KEY GOTO MENU');
end

else
begin
writeln ('pelanggan CUCIAN');
writeln ('+----+---------+----------+------------+--------+');
writeln ('| No | Nama | Alamat | Jenis Cuci | Jumlah |');
writeln ('+----+---------+----------+------------+--------+');
begin
for i := 1 to n do
with data[i] do
writeln ('|',i:2,' |',nm:6,' |',al:6,' |',jn:6,' |',jm:5,' |');
writeln ('+----+---------+----------+------------+--------+');
writeln;
writeln;
end;
end;
readln;
end;
procedure sorting1(var x:lar);
var temp:recdata;
begin
for i:=1 to n-1 do
begin
for k:=i+1 to n do
begin
if x[i].nm>x[k].nm then
begin
temp:=x[i];x[i]:=x[k];x[k]:=temp;
end;
end;
end;
end;
procedure sorting2(var x:lar);
var temp:recdata;
begin
for i:=1 to n-1 do
begin
for k:=i+1 to n do
begin
if x[i].jm begin
temp:=x[i];x[i]:=x[k];x[k]:=temp;
end;
end;
end;
end;
procedure cari(var x:lar);
var ketemu : boolean;
cari : string;
begin
writeln;
write('Nama Pelanggan yang akan dicari alamatnya? ');readln(cari);
ketemu:=false;
for i:=1 to n do
begin
if data[i].nm=cari then ketemu:=true;
end;
clrscr;
begin
if ketemu then
writeln('Alamat Pelanggan ',cari,' adalah ',data[i].al)
else
writeln('tidak ada nama pelanggan ',cari,' dalam daftar');
end;
end;
begin
s.top := 0;
n := 0;
awal:
clrscr;
writeln ('+----------------------------+');
writeln ('| ISTA LOUNDRY |');
writeln ('+----------------------------+');
writeln ('| 1. Tambah cucian |');
writeln ('| 2. Ambil cucian |');
writeln ('| 3. Tampil Data |');
writeln ('| 4. Sorting Berdasar NAMA |');
writeln ('| 5. Sorting Berdasar JUMLAH |');
writeln ('| 6. Cari Data |');
writeln ('| 7. EXIT |');
writeln ('+----------------------------+');
write ('menu pilihan [1/2/3/4/5/6/7] : ');
readln(p);
case p of
'1' : begin
input(data);
goto awal;
end;
'2' : begin
clrscr;
ambil;
goto awal;
end;
'3' : begin
look(data);
goto awal;
end;
'4' : begin
writeln('DATA NAMA SESUDAH DI SORTING');
sorting1(data);
look(data);
goto awal;
end;
'5' : begin
writeln('DATA JUMLAH SESUDAH DI SORTING');
sorting2(data);
look(data);
goto awal;
end;
'6' : begin
clrscr;
cari(data);
goto awal;
end;
'7' : halt;
end;
end.

0 comments: