program toko_beras;
uses crt;
type rec_beras=record
merk:string;
harga:longint;
stok:byte;
end;
array_beras=array[1..20] of rec_beras;
type rec_beli=record
merk,nama:string;
jum:byte;
total:longint;
end;
array_beli=array[1..20] of rec_beli;
var beras,sementara:array_beras;
pembeli:array_beli;
i,j,pil,n,m:byte;
pendapatan:longint;
ketemu:boolean;
procedure tambah_merk(var x:array_beras);
var merkbaru:string;
begin
ketemu:=false;
writeln('menambah merk beras baru');
write('masukkan merk beras : ');readln(merkbaru);
{cek merk sudah ada/belum}
for i:=1 to n do
begin
if (x[i].merk=merkbaru) then
begin
ketemu:=true;
writeln('Merk tersebut sudah ada');
end;
end;
if not ketemu then
begin
inc(n);
x[n].merk:=merkbaru;
write('harga per kg ? ');readln(x[n].harga);
end;
end;
procedure tambah_stok(var x:array_beras);
var tanya_merk:string;
ada:boolean;
posisi,tambah:byte;
begin
ada:=false;
write('masukkan merk beras yang akan ditambah / diisi stok : ');readln(tanya_merk);
{mengecek merk di array}
for i:=1 to n do
begin
if (x[i].merk=tanya_merk) then
begin
ada:=true;posisi:=i;
end;
end;
if ada then {jika merk sudah ada di array, lakukan penambahan stok}
begin
write('tambah stok berapa kg ? ');readln(tambah);
x[posisi].stok:=x[posisi].stok+tambah;
end
else writeln('merk tersebut belum ada ');
end;
procedure pembelian;
var beli_beras:string;
tersedia:boolean;
posisi:byte;
begin
writeln('PEMBELIAN BERAS');
write('masukkan merk beras yang akan dibeli: ');readln(beli_beras);
{mengecek ketersediaan beras di larik beras}
for i:=1 to n do
begin
if (beras[i].merk=beli_beras) and (beras[i].stok>0) then
begin tersedia:=true;posisi:=i; end;
end;
{jika beras available lakukan pembelian}
if tersedia then
begin
inc(m);
pembeli[m].merk:=beli_beras;
write('masukkan nama pembeli = ');readln(pembeli[m].nama);
write('beli berapa kg = ');readln(pembeli[m].jum);
pembeli[m].total:=pembeli[m].jum*beras[posisi].harga;
beras[posisi].stok:=beras[posisi].stok-(pembeli[m].jum); {mengurangi stok}
end
else writeln ('merk beras atau stok tidak tersedia');
end;
procedure cetak_beras(var x:array_beras);
begin
writeln('-------------------------------------');
writeln(' No Merk Stok Harga per kg');
writeln('-------------------------------------');
for i:=1 to n do with x[i] do
writeln(i:2,' ',merk:12,' ',stok:4,' ','Rp',harga:10);
writeln('-------------------------------------');
end;
procedure sorting_beras(var x:array_beras);
var temp:rec_beras;
begin
{mengisi array bayangan}
for i:=1 to n do sementara[i]:=x[i];
{mengurutkan array bayangan}
for i:=1 to n-1 do
begin
for j:=i+1 to n do
begin
if (sementara[i].merk > sementara[j].merk) then
begin
temp:=sementara[i];
sementara[i]:=sementara[j];
sementara[j]:=temp;
end;
end;
end;
end;{end procedure sorting}
procedure cetak_beli(var y:array_beli);
begin
writeln('----------------------------------------------------------------');
writeln(' NO Merk Beras Pembeli jumlah beli (kg) Total Bayar');
writeln('----------------------------------------------------------------');
for i:=1 to m do with y[i] do
begin
pendapatan:=pendapatan+total;
writeln(i:2,' ',merk:12,' ', nama:10,' ',jum:18,' ','Rp',total:15);
end;
writeln('-----------------------------------------------------------------');
end;
{program utama}
begin
repeat
begin
clrscr;
writeln(' TOKO BERAS LARISO');
writeln('********************************');
writeln('1. Tambah merk beras *');
writeln('2. Tambah stok beras *');
writeln('3. Pembelian *');
writeln('4. Sorting Beras berdasar merk *');
writeln('5. Cetak stok Beras *');
writeln('6. Cetak Pembelian *');
writeln('7. Rekap pendapatan *');
writeln('8. Tutup *');
writeln('********************************');
write('Pilih menu ==> ');readln(pil);
case pil of
1: tambah_merk(beras);
2: tambah_stok(beras);
3: pembelian;
4: begin sorting_beras(beras);cetak_beras(sementara);end;
5: cetak_beras(beras);
6: cetak_beli(pembeli);
7: begin
writeln('Hari ini terjadi ',m,' pembelian, dengan pendapatan Rp', pendapatan);
writeln('Lancar terusss');
end;
8: writeln('Terimakasih');
end;
readln;
end
until (pil=8);
end.
Jumat, Desember 13, 2013
Langganan:
Posting Komentar (Atom)

0 komentar:
Posting Komentar