Jumat, Desember 13, 2013

program pascal penjulan

Diposting oleh ajeng diana di 07.34
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.

0 komentar:

Posting Komentar

 

ajeng diana Copyright © 2015 Design by ajengdiana dianastore