uses wincrt;
const max=25;
type antrian=record
nama:array[1..max] of string;
belanja:array[1..max] of longint;
depan,belakang:0..max;
end;
var Q:antrian;
namabaru,namaambil:string;
uangmasuk,masukkas:longint;
pendapatan:real;
cacah,i:byte;
lagi:boolean;
pilih:1..4;
function penuh(q:antrian):boolean;
begin
if q.belakang=max then penuh:=true else penuh:=false;
end;
function kosong(q:antrian):boolean;
begin
if q.belakang=0 then kosong:=true else kosong:=false;
end;
procedure pushq(var q:antrian;n:string;j:longint);
begin
if penuh(q) then writeln('antrian penuh')
else
begin
inc(q.belakang);
q.nama[q.belakang]:=n;
q.belanja[q.belakang]:=j;
end;
end;
procedure popq(var q:antrian);
begin
if kosong(q) then writeln('tidak ada yang mengantri di kasir')
else
begin
namaambil:=q.nama[q.depan];
masukkas:=q.belanja[q.depan];
inc(cacah);pendapatan:=pendapatan+masukkas;
writeln('yang dilayani adalah ' , namaambil , ' dengan belanja sebesar Rp',masukkas:8);
{pergeseran posisi pengantri}
for i:= 1 to q.belakang-1 do
begin q.nama[i]:=q.nama[i+1];
q.belanja[i]:=q.belanja[i+1];
end;
dec(q.belakang);
end;
end;{end procedure}
procedure cetakq(var q:antrian);
begin
if kosong(q) then writeln('tidak ada pelanggan dalam antrian')
else
begin
writeln('pelanggan yang antri saat ini ====>');
writeln;
for i:=1 to q.belakang do
writeln('posisi ',i:4,' atas nama',q.nama[i],'jumlah belanja Rp',q.belanja[i]);
end;
end;
{menu utama}
begin
lagi:=true;q.depan:=1;q.belakang:=0;
while lagi do
begin
clrscr;
writeln('KASIR TOKO BOLU ENAK');
writeln('1. Tambah Pengantri');
writeln('2. Layani Pengantri');
writeln('3. Cetak Antrian');
writeln('4. selesai, Cetak Pendapatan');
write('Pilih 1-4 ===> ');readln(pilih);
case pilih of
1:begin
write('nama pengantri =');readln(namabaru);
write('jumlah belanja =');readln(uangmasuk);
pushq ( q,namabaru,uangmasuk);
end;
2:popq(q);
3:cetakq(q);
4:begin
writeln('pelanggan ini sebanyak ',cacah:4,'orang');
writeln('pendapatan hari ini sebesar Rp',pendapatan:8:2);
writeln('Thankyou');
lagi:=false;
end;
end;
readln;
end;
end.
Translate
uses wincrt;
var
a:array[1..5,1..5] of byte;
x,i,j,Mak,Min:integer;
begin
clrscr;
write('berapa jumlah data? ' );readln(x);
for i:=1 to x do
for j:=1 to x do
begin
write('masukkan data ke ',i,',',j,'= ');readln(a[i,j]);
end;
Mak:= a[i,j];
Begin
For i :=1 to x do
For j :=1 to x do
If a[i,j]> Mak then
Begin
Mak:= a[i,j];
End;
Min:= a[i,j];
Begin
For i :=1 to x do
For j :=1 to x do
If a[i,j]< Min then
Begin
Min:= a[i,j];
End;End;End;
for i:=1 to x do
begin
for j:=1 to x do
write(a[i,j]:13);
writeln;
end;
writeln;
Writeln('nilai Tertinggi : ',Mak);
Writeln('nilai Terendah : ',Min);
writeln;
end.
uses wincrt;
var angka:array [1..10] of integer;
i,j,n:byte;
x:integer;
begin
repeat
begin
inc(n);
write('isi bilangan bulat berhenti isi 999 ');readln(angka[n]);
end
until angka [n]=999 ;
dec(n);
writeln('sebelum diurutkan==> ');
for i:=1 to n-1 do
begin
for j:=i+1 to n do
begin
if angka[i]>angka[j]then
begin x:=angka[i];angka[i]:=angka[j];angka[j]:=x;end;
end;
end;
writeln;writeln('sesudah diurutkan');
for i:= 1 to n do write(angka[i]:5);
end.
Program Stack (Tumpukan) Menggunakan Sorting & Searching
Posted: by Ajiex Estrada in Labels: Programuses 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
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.