Translate

Program Antrian

Posted: Sabtu, 14 Mei 2011 by Ajiex Estrada in Labels:
0

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.

Perjuangan dan Kesabaran

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

Hidup adalah perjuangan. Itu kata orang. Memang benar, dalam hidup akan penuh dengan perjuangan. Terutama bagi mereka yang memiliki cita-cita besar, baik cita-cita pribadi maupun cita-cita dalam dakwah. Bagi mereka yang tidak memiliki cita-cita besar, tidak akan mampu melihat bahwa hidup penuh dengan perjuangan. Yang ada di depan mereka hanyalah bagaimana mencari kesenangan belaka.

Jika Anda merasa bahwa hidup penuh tantangan, halangan, rintangan, dan ujian, artinya hidup Anda memang penuh perjuangan. Anda termasuk orang yang memiliki cita-cita yang tinggi, baik meraih pencapaian yang besar maupun melepaskan diri dari masalah besar yang menghimpit. Satu hal yang diperlukan dalam perjuangan adalah kesabaran.

Program Array 2 Dimensi

Posted: by Ajiex Estrada in Labels:
0

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.

Program Sorting Angka

Posted: by Ajiex Estrada in Labels:
0

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:
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.