Minggu, 11 Desember 2011

Contoh Program Antrian

uses wincrt;
const max=10;
type antrian=array[1..max] of string;
var antri:antrian;
    i,ngarep,mburi:integer;
    data:string;
    pil:char;
function full:boolean;
begin
full:=((mburi=ngarep-1)and(mburi>0)or((ngarep=1)and(mburi=max)));
end;
procedure pesan;
begin
clrscr;
if full then writeln('Antrian Penuh')
else
writeln('Antrian Kosong');
readln;
end;
procedure masuk (x:string);
begin
if mburi=max then mburi:=1
else
mburi:=mburi+1;
antri[mburi]:=x;
end;
procedure input;
begin
clrscr;
if not full then
begin
write('Nama Pelanggan : ');
readln(data);
masuk(data);
end
else
pesan;
end;
procedure keluar;
var x:string;
begin
clrscr;
if not (mburi=0) then
begin
x:=antri[ngarep];
if mburi=ngarep then
begin
ngarep:=1;
mburi:=0;
end
else
begin
if ngarep=max then ngarep:=1
else ngarep:=ngarep+1;
end;
writeln('Pelanggan yang telah selesai ',x);
readln;
end
else
pesan;
end;
procedure lihat;
begin
clrscr;
if not (mburi=0) then
begin
if(mburi<=max)and(mburi>ngarep)then
for i:=ngarep to mburi do
writeln(antri[i])
else
if(ngarep>0)and (mburi<ngarep) then
begin
for i:=ngarep to max do
writeln(antri[i]);
for i:=1 to mburi do
writeln(antri[i]);
end
else
writeln(antri[mburi]);
readln;
end
else
pesan;
end;
begin
ngarep:=1;
mburi:=0;
repeat
clrscr;
writeln('       Warung Ess Seeggeerrr');
writeln('              By Tombels');
writeln;
writeln('1. Tambah antrian');
writeln('2. Keluarkan 1 antrian');
writeln('3. Lihat antrian');
writeln('4. Berhenti');
writeln;
write('Pilih salah satu menu : ');
readln(pil);
case pil of
'1':input;
'2':keluar;
'3':lihat;
'4':begin
    clrscr;
    writeln('   Terima kasih atas kunjungan anda di warung Ess Seeggeerrr');
    writeln('Semoga anda dapat menikmati semua menu yang ada di tempat kami ini');
    writeln('           Selamat jalan semoga sampai tujuan.');
    end;
end;
until pil='4';
end.