Program data_perpustakaan

Program data_perpustakaan;
Uses winCrt ;
Type
perpustakaan = Record
KdBuku : word;
Judul : String[20];
Jenis : string[20];
Pengarang : string[20];
Penerbit : string[20];
Harga : real;
Nama : String[20];
End;
Var
prpus : File of Perpustakaan;
Data : Perpustakaan;
Pil,lgi : Char;
i : integer;
Procedure Menu;
Begin
Clrscr;
writeln('             PROGRAM PERPUSTAKAAN');
writeln(' INSTITUT SAINS & TEKNOLOGI AKPRIND YOGYAKARTA ');
writeln('====================================================');
writeln('Nama Pemegang Saham  Perpustakaan Ini Adalah:');
writeln('NAMA : ALFIANDRI          : 121051128');
writeln('NAMA : ASRI RESPATI       : 121051070');
writeln('Nama : Adib arwanda kusuma: 121051072');
writeln('====================================================');
Writeln('           MENU UTAMA');
writeln('====================================================');
Writeln('1. TAMBAH DATA BUKU');
Writeln('2. EDIT DATA BUKU');
Writeln('3. TAMPILKAN DATA BUKU');
Writeln('4. HAPUS DATA BUKU');
Writeln('5. KELUAR PROGRAM');
Write('Pilihan [1..5]: ');Pil:=Readkey;
End;
Procedure BukaFile;
Begin
Assign(prpus,'perpustakaan.txt');
Reset(prpus);
End;
Procedure Tambah;
Var
Lagi: Char;
Ada : Boolean;
i : Integer;
kode: Word;
Begin
lgi :='Y';
Lagi:='Y';
Clrscr;
BukaFile;
Rewrite(prpus);
Repeat
Clrscr;
Ada:=False;
i:=0;
Writeln('TAMBAH DATA BUKU ');
Writeln('----------------');
Write('Kode Buku : ');Readln(kode);
While (Ada=False) And (i<>Filesize(prpus)) Do
Begin
Seek(prpus,i);
Read(prpus,Data);
If Data.KdBuku=kode Then
Ada:=True
Else
Inc(i);
End;
If (Ada=True) Then
Begin
Writeln('Kode Buku Ini Sudah ada!');
End
Else
Begin
Seek(prpus,Filesize(prpus));
Data.KdBuku:=kode;
Write('Judul Buku : ');Readln(Data.judul);
Write('Jenis Buku : ');Readln(Data.Jenis);
Write('Pengarang : ');Readln(Data.Pengarang);
Write('Penerbit : ');Readln(Data.Penerbit);
Write('Harga Sewa : ');Readln(Data.Harga);
Write(prpus,Data);
End;
Write('Apakah Mau Tambah Data Lagi [Y/T]:');Lagi:=Upcase(Readkey);
Until Lagi<>'Y';
Close(prpus);
End;
Procedure Edit;
Var
Lagi : Char;
Ada : Boolean;
i : Integer;
kode: Word;
Begin
lgi :='Y';
Lagi:='Y';
Clrscr;
BukaFile;
If IOResult<>0 Then
Write('Data Masih Kosong...!')
Else
Begin
Repeat
Clrscr;
Ada:=False;
i:=0;
Writeln('EDIT DATA BUKU');
Writeln('**************');
Write('Kode Buku : ');Readln(kode);
While (Ada=False) And (i<>Filesize(prpus)) Do
Begin
Seek(prpus,i);
Read(prpus,Data);
If Data.KdBuku=kode Then
Begin
Ada:=True;
writeLN('   Data Buku');
writeLN('===============');
Write('Judul Buku : ');writeln(Data.judul);
Write('Jenis Buku : ');writeln(Data.Jenis);
Write('Pengarang : ');writeln(Data.Pengarang);
Write('Penerbit : ');writeln(Data.Penerbit);
Write('Harga Sewa : ');writeln(round(Data.Harga));
End
Else
Inc(i);
End;
If (Ada=True) Then
Begin
Data.KdBuku:=kode;
writeln;
writeln('Masukan Data Buku');
writeln('==================');
Write('Judul Buku : ');readln(Data.judul);
Write('Jenis Buku : ');readln(Data.Jenis);
Write('Pengarang : ');readln(Data.Pengarang);
Write('Penerbit : ');readln(Data.Penerbit);
Write('Harga Sewa : ');readln(Data.Harga);
Seek(prpus,i);
Write(prpus,Data);
End
Else
Begin
Write('Nomor kode "',kode,'" Ini Tidak Ada!');
End;
Write('Apakah Mau Edit Data Lain [Y/T]: ');Lagi:=Upcase(Readkey);
Until Lagi<>'Y';
End;
Close(prpus);
End;
Procedure Tampil;
Var
i,n : Integer;
Begin
clrscr;
lgi :='Y';
BukaFile;
If IoResult <> 0 Then
begin
Write('Maaf Data Masih Kosong ! ');
end
Else
Begin
Clrscr;
writeln('             ==========DATA BUKU==========');
writeln('|NO|KODE|JUDUL BUKU|JENIS BUKU|PENGARANG|PENERBIT|H.SEWA|');
i:=0;
While Not EoF(prpus) Do
Begin
Inc(i);
Read(prpus,Data);
write('| ',i);
write('|'); write(data.kdbuku);
write(' |'); write(data.judul);
write('   |'); write(data.jenis);
write('          |'); write(data.pengarang);
write('  |'); write(data.penerbit);
write('   |'); write(round(data.harga));
writeln(' |');
End;
Close(prpus);
End;
Writeln;
Write(' Tekan Enter untuk Kembali Kemenu Utama ');Readln;
End;
Procedure Hapus;
Var
FileTmp : File of Perpustakaan;
Lagi,Hapus : Char;
Ada : Boolean;
i : Integer;
kode : Word;
Begin
lagi :='Y';
Lagi:='Y';
Clrscr;
Repeat
BukaFile;
If IOResult<>0 Then
Write('Data Masih Kosong...!')
Else
Begin
Clrscr;
Assign(FileTmp,'perpustakaan.tmp');
Rewrite(FileTmp);
Ada:=False;
i:=0;
Writeln('HAPUS DATA BUKU');
Writeln('-----------------');
Write('Kode Buku : ');Readln(kode);
While (Ada=False) And (i<>Filesize(prpus)) Do
Begin
Seek(prpus,i);
Read(prpus,Data);
If Data.KdBuku=kode Then
Ada:=True
Else
Inc(i);
End;
If (Ada=True) Then
Begin
Write('Judul Buku : ');writeln(Data.judul);
Write('Jenis Buku : ');writeln(Data.Jenis);
Write('Pengarang : ');writeln(Data.Pengarang);
Write('Penerbit : ');writeln(Data.Penerbit);
Write('Harga Sewa : ');writeln(round(Data.Harga));
Write('Apakah Data Ini Mau Di Hapus [Y/T]: ');Readln(Hapus);
If Upcase(Hapus)='Y' Then
Begin
For i := 1 to Filesize(prpus) Do
Begin
Seek(prpus,i-1);
Read(prpus,Data);
If Data.KdBuku<>kode Then
Write(FileTmp,Data);
End;
Close(prpus);
Assign(prpus,'perpustakaan.txt');
Erase(prpus);
Assign(FileTmp,'perpustakaan.tmp');
Rename(FileTmp,'perpustakaan.txt');
Write(' Nomor Kode "',kode,'" Sudah Di Hapus! ');
End;
End
Else
Begin
Write('Nomor Kode "',kode,'" Ini Tidak Ada!');
End;
Write('Mau Hapus Data Lain [Y/T]: ');Lagi:=Upcase(Readkey);
End;
Until Lagi<>'Y';
End;
procedure keluar;
begin
writeln;
writeln('Terima Kasih Telah Berkunjung Di Perpustakaan Kami');
writeln(' INSTITUT SAINS & TEKNOLOGI AKPRIND YOGYAKARTA ');
writeln('====================================================');
writeln('NAMA : ALFIANDRI          : 121051128');
writeln('====================================================');
End;
Begin
Repeat
Menu;
Case Pil Of
'1' : Tambah;
'2' : Edit;
'3' : Tampil;
'4' : Hapus;
'5' : keluar;
End;
Until (lgi<>'Y') Or (Pil='5');
End.

Read More

program contoh_record;

program contoh_record;

uses wincrt;

type mahasiswa=record

     nim,nama,prodi:string;

     ip:real;

     jk:real;

     end;

     larik_mhs=array[1..20] of mahasiswa;

var

   mhs:larik_mhs;

   bayangan:larik_mhs;

   i,n,j:byte;

   lagi:char;

   pil:1..11;

procedure isi_data(var X:larik_mhs);

begin

     repeat

     begin

          inc(n);

          writeln('Mengisi data mahasiswa ke ',n);

          write('masukkan nim --> ');readln(X[n].nim);

          write('masukkan nama --> ');readln(X[n].nama);

          write('wanita/pria (1/0) --> ');readln(X[n].jk);

          write('masukkan prodi --> ');readln(X[n].prodi);

          write('masukkan ip --> ');readln(X[n].ip);

          writeln;

          write('tambah lagi <y/t>? ');readln(lagi);

     end

     until (lagi<>'y');

end;

procedure cetak(var X:larik_mhs);

var gender:string;

begin

     writeln('DAFTAR MAHASISWA IST AKPRIND YOGYAKARTA 2012');

     writeln('--------------------------------------------');

     writeln('NO NIM      NAMA         PRODI       JK   IP');

     writeln('--------------------------------------------');

     for i:=1 to n do with X[i] do

     begin

          if jk=0 then gender:='pria' else gender:='wanita';

          writeln(i:2,' ',nim:5,' ',nama:10,' ',prodi:10,' ',gender:8,' ',ip:6:2);

     end;

     writeln('--------------------------------------------');

end;

procedure filter_ip(var X:larik_mhs);

var fil:1..3;

begin

     writeln('1.Tampilkan ip < 2.00');

     writeln('2.Tampilakn ip 2.00 - 3.00');

     writeln('3.Tampilkan ip > 3.00');

     write('pilih <1-3> ');readln(fil);

     if fil=1 then

     begin

          writeln('mahasiswa dengan ip kurang dari 2.00 adalah sbb');

          writeln;

          for i:=1 to n do

          begin

               if X[i].ip < 2.0 then

               writeln(i:2,' ',X[i].nim:9,' ',X[i].nama:15,' ',X[i].prodi:10,X[i].ip:6:2);

          end;

     end

     else if fil=2 then

     begin

     writeln('mahasiswa dengan ip 2.00 - 3.00 adalah sbb');

          writeln;

          for i:=1 to n do

          begin

               if (X[i].ip >= 2.00) and (X[i].ip <= 3.00) then

               writeln(i:2,' ',X[i].nim:9,' ',X[i].nama:15,' ',X[i].prodi:10,X[i].ip:6:2);

          end;

     end

     else

     begin

     writeln('mahasiswa dengan ip lebih dari 3.00 adalah sbb');

          writeln;

          for i:=1 to n do

          begin

               if X[i].ip > 3.0 then

               writeln(i:2,' ',X[i].nim:9,' ',X[i].nama:15,' ',X[i].prodi:10,X[i].ip:6:2);

          end;

     end;

end;{end procedure filter_ip}

procedure hapus(var X:larik_mhs);

var delet:byte;

begin

     write('record nomor berapa yang akan dihapus ? ');readln(delet);

     for i:=delet to n-1 do X[i]:=X[i+1];

     dec(n);

     writeln('record no ',delet,' sudah dihapus');

end;

procedure sorting_ip(var X:larik_mhs);

var

    sementara:mahasiswa;

begin

     {mengisi array bayangan dengan data array asal}

     for i:=1 to n do bayangan[i]:=X[i];

     {mengurutkan bayangan, array asli tidak diurutkan}

     for i:=1 to n-1 do

     begin

          for j:=i+1 to n do

          begin

               if (bayangan[i].ip<bayangan[j].ip) then

               begin

                    sementara:=bayangan[i];

                    bayangan[i]:=bayangan[j];

                    bayangan[j]:=sementara;

               end;

          end;

     end;

     writeln('data setelah diurutkan berdasar ip');writeln;

     cetak(bayangan);

end;

{program utama}

begin

     repeat

     begin

          writeln('     MENGELOLA DATA MAHASISWA');

          writeln('1.Isi/tambah data');

          writeln('2.Mencari nama tertentu');

          writeln('3.Mencari ip tertentu');

          writeln('4.Filtering berdasar ip');

          writeln('5.Filtering berdasar jenis kelamin');

          writeln('6.Filtering berdasar program studi');

          writeln('7.Mencari ip tertinggi dan terendah');

          writeln('8.Menghapus record tertentu');

          writeln('9.Cetak tabel');

          writeln('10.Sorting ip');

          writeln('11.Selesai');

          writeln;

          write('pilihan anda [1..11] --> ');readln(pil);

          case pil of

          1:isi_data(mhs);

          {2:cari_nama(mhs);

          3:cari_ip(mhs);}

          4:filter_ip(mhs);

          {5:filter_jk(mhs);

          6:filter_prodi(mhs);

          7:maxmin_ip(mhs);}

          8:hapus(mhs);

          9:cetak(mhs);

          10:sorting_ip(mhs);

          11:writeln('Terima Kasih');

          end;

          readln;

     end

     until (pil=10);

end.

Read More

program penjualan

program penjualan;
uses wincrt ;
type
data=record
no,jumlah:integer;
nama_barang:string;
harga,harga_barang:real;
end;
var
rdata:array[1..100]of data;
filedata:file of data;
f:data;
nomor:integer;
datacari:string;
procedure tambah;
var
i:integer;
lagi:char;
begin
clrscr;
writeln('Masukan data barang');
assign(filedata,'jual.dat');
 reset(filedata);
 seek(filedata,filesize(filedata));
  write('Nama barang : ');
  readln(f.nama_barang);
  write('harga:');
  readln(f.harga);
  write('jumlah :');
  readln(f.jumlah);
  f.harga_barang:=f.harga*f.jumlah;
  write(filedata,f);
  close(filedata);
end;
procedure hapus;
var
i,j:integer;
nm:string;
begin
assign(filedata,'jual.dat');
 reset(filedata);
 j:=0;
 while not Eof(filedata) do
  begin
     inc(j);
     read(filedata,rdata[j]);
  end;
write('Masukan nama barang yang ingin di hapus :');readln(nm);
 i:=1;
while(i<=j)and (rdata[i].nama_barang<>nm) do
inc(i);
  if nm=rdata[i].nama_barang then
   begin
   dec(j);
    for i:=i to j do
     rdata[i]:=rdata[i+1];
     rewrite(filedata);
     for i:=1 to j do
     write(filedata,rdata[i]);
     write(' Tekan enter untuk memulai menghapus ');readln;
     writeln(' S U K S E S ');
   end
   else
   write('maaf barang tidak di temukan ');readln;
   close(filedata);
  end;
procedure edit_data;
var
i,p:integer;
lagi:char;
dataedit:string;
begin
assign(filedata,'jual.dat');
reset(filedata);
write('masukan nama barang yang akan di edit  : ');readln(dataedit);
i:=1;
while not Eof(filedata) do
begin
read(filedata,rdata[i]);
begin
if dataedit = rdata[i].nama_barang then
 begin
  p:=filepos(filedata);writeln(p);
  p:=p-1;
  seek(filedata,p);
  writeln('input data pengganti :');
   writeln('no ',i:2);
   write('nama barang :');read(rdata[p].nama_barang);
   write('harga       :');read(rdata[p].harga);
   write('jumlah      :');read(rdata[p].jumlah);
   rdata[p].harga_barang:=rdata[p].harga*rdata[p].jumlah;
   write(filedata,rdata[p]);
 end ;
end;
i:=i+1;
end;
close(filedata);
end;
procedure in_data_barang;
var i:integer;
    lagi:char;
begin
i:=1;
assign(filedata,'jual.dat');
 rewrite(filedata);
 reset(filedata);
 begin
repeat
 begin
   clrscr;
   writeln('no :  ',i);
   write('nama barang :');readln(rdata[i].nama_barang);
   write('harga       :');readln(rdata[i].harga);
   write('jumlah      :');readln(rdata[i].jumlah);
   rdata[i].harga_barang:=rdata[i].harga*rdata[i].jumlah;
   write(filedata,rdata[i]);
   writeln;
   write('ingin masukan data lagi [y/t] : ');readln(lagi);
   i:=i+1;
 end;
 until ((lagi='t') or (lagi='T'));
 close(filedata);
 end;
 end;
procedure tampil_daftar_barang;
var i:integer;
begin
assign(filedata,'jual.dat');
reset(filedata);
i:=1;
while not Eof(filedata) do
begin
 read(filedata,rdata[i]);
if (rdata[i].harga)>=1000000 then
    begin
  write(i);
  write('    ',rdata[i].nama_barang:10);
  write('                       ',rdata[i].harga:10:0);
  write('     ',rdata[i].jumlah:2);
  writeln;
 i:=i+1;
 end;
 end;writeln;
 end;
procedure cetak_daftar_barang;
var i,pilih:integer;
    total,uang,kembalian:real;
begin
repeat
clrscr;
assign(filedata,'jual.dat');
reset(filedata);
 total:=0;
 begin
writeln('             ***************DAFTAR PENJUALAN*************** ');
writeln('==========================================================================');
writeln('NO   NAMA BARANG                          HARGA/S   JUMLAH    HARGA BARANG');
writeln('==========================================================================');
i:=1;
while not Eof(filedata) do
begin
 read(filedata,rdata[i]);
  write(i);
  write('    ',rdata[i].nama_barang:10);
  write('                       ',rdata[i].harga:10:0);
  write('     ',rdata[i].jumlah:2);
  write('      ',rdata[i].harga_barang:8:0);
  writeln;
  total:=total+rdata[i].harga_barang;
  i:=i+1;
 end;
writeln('---------------------------------------------------------------------');
writeln('                                         TOTAL PEMBAYARAN    = Rp. ',total:3:0);
write('                                         Masukan jumlah uang = Rp. ');readln(uang);
kembalian:=uang-total;
writeln('                                              uang kembalian = Rp. ',kembalian:2:0);
writeln('                 TERIMA KASIH ATAS KUNJUNGANNYA')   ;
writeln('                SAMPAI JUMPA LAGI DI LAIN WAKTU ');
writeln('                    IST AKPRIND YOGYAKARTA');
tampil_daftar_barang;
end;
writeln('    *****Pilihan*****');
writeln('**************************');
writeln('1. Tambah data penjualan');
writeln('2. Hapus data penjualan');
writeln('3. Edit data penjualan');
writeln('4. Ke MENU Utama');
writeln('**************************');
write('Pilih Data yang diinginkan = ');readln(pilih);
case pilih of
 1:tambah;
 2:hapus;
 3:edit_data;
 end;
 until(pilih =4);
end;
procedure cari;
var
i,jumlah:integer;
cocok,nama:string;
harga,harga_barang:real;
begin
 assign(filedata,'jual.dat');
 reset(filedata);
  cocok:=datacari;

   begin
   i:=1;
   while not Eof(filedata)do
    begin
    read(filedata,rdata[i]);
    if cocok=rdata[i].nama_barang then
     begin
     nama:=rdata[i].nama_barang;
     harga:=rdata[i].harga;
     jumlah:=rdata[i].jumlah;
     harga_barang:=rdata[i].harga_barang;
    end;
     end;
     i:=i+1;
     end;
if(nama='')then
 begin
  writeln(' MAAF DATA TIDAK TERSEDIA ')
  end
  else
  begin
  writeln('               **********DAFTAR PENCARIAN********** ');
writeln('======================================================================');
writeln(' NAMA BARANG                          HARGA/S   JUMLAH    HARGA BARANG');
writeln('======================================================================');
  writeln;
  write(nama:10);
  write(                   harga:35:0);
  write(jumlah:8);
  write(harga_barang:12:0);
  writeln;
  writeln('------------------------------------------------------------------------');
  writeln;
  end;
nama:='';
harga:=0;
jumlah:=0;
harga_barang:=0;
end;
procedure cek_data_barang;
var
lagi:char;
begin
 repeat
 clrscr;
write('masukan nama barang yang di cari  : ');readln(datacari);
clrscr;
cari;
write('Apakah ingin mencari data barang lagi ? [y/ t] ');readln(lagi);
writeln;
until (lagi='T')or (lagi='t');
end;
begin
repeat
clrscr;
writeln('    WELCOME TO SUPERMARKET IST AKPRIND YOGYAKARTA');
writeln('=======================================================');
writeln('   *****Nama-Nama Kelompok*****');
writeln('NAMA : ALFIANDRI          : 121051128');
writeln('********************************************************');
  writeln('    *****MENU*****');
  writeln('************************');
  writeln('1. MASUKAN DATA BARANG');
  writeln('2. CARI DATA BARANG');
  writeln('3. CETAK DAFTAR BARANG');
  writeln('4. E X I T');
  writeln('************************');
  writeln;
write('Pilih menu yang anda mau = ');readln(nomor);
  clrscr;
case nomor of
  1:in_data_barang;
  2:cek_data_barang;
  3:cetak_daftar_barang;
end;
until nomor=4;
end.

Read More

program swalayan

program penjualan_supermaket;

uses wincrt;

var i,b:byte;

n_brg,kd_brg:array [1..50] of string[20];

banyak,jmlharga,harga:array[1..50]of real;

totb,totjml,total,uang,kembalian,diskon:real;

lagi,baca_t:char;

begin

lagi := 'y';                                                                       

while  (lagi) = 'y' do

begin

clrscr;

writeln('          WELCOME TO SUPERMARKET IST AKPRIND YOGYAKARTA');

writeln('=======================================================');

writeln('Nama Pemegang Saham  Supermarket Ini Adalah:');

writeln('NAMA : ALFIANDRI          : 121051128');

writeln('NAMA : ZAINAL ABIDIN      : 121051066');

writeln('NAMA : ASRI RESPATI       : 121051070');

write('masukan jumlah barang = ');readln(b);

for i:=1 to b do

begin

writeln;

writeln('barang ke- ',i);

writeln;

write('masukan kode barang : ');readln(kd_brg[i]);

write('masukan jumlah barang : ');readln(banyak[i]);

end;

writeln;

clrscr;

writeln('          WELCOME TO SUPERMARKET IST AKPRIND YOGYAKARTA');

writeln('=======================================================');

writeln('NO      NAMA BARANG                     HARGA SATUAN|BANYAK BELI|JUMLAH HARGA');

writeln;

for i:=1 to b do

begin

if kd_brg[i]='111'then

begin

n_brg[i]:='wafer tenggo ' ;

harga[i]:=5800;

end else if kd_brg[i]='123'then begin

n_brg[i]:='fanta 250 ml';

harga[i]:=4000;

end else if kd_brg[i]='1234' then begin

n_brg[i]:='sprite 1,5 ltr';

harga[i]:=12000;

end else if kd_brg[i]='12345' then begin

n_brg[i]:='aqua Botol 1500 ml';

harga[i]:=2800;

end else if kd_brg[i]='1234567' then begin

n_brg[i]:='Coca-cola botol 1,5 ltr zero';

harga[i]:=12000;

end else if kd_brg[i]='12345678' then begin

n_brg[i]:='green tea 8gr';

harga[i]:=4500;

end else if kd_brg[i]='123456789' then begin

n_brg[i]:='Nu green tea apple 330ml';

harga[i]:=4400;

end else if kd_brg[i]='12345678910' then begin

n_brg[i]:='Bimoli minyak goreng botol 1000 ml';

harga[i]:=26500;

end else if kd_brg[i]='220' then begin

n_brg[i]:='pedia sure complete cokelat 400gr';

harga[i]:=90000;

end else if kd_brg[i]='221' then begin

n_brg[i]:='Sania minyak goreng 5 ltr';

harga[i]:=67000;

end else if kd_brg[i]='222' then begin

n_brg[i]:='sasa 250gr';

harga[i]:=6200;

end else if kd_brg[i]='223' then begin

n_brg[i]:='ABC sambal extra pedas 140 ml';

harga[i]:=4300;

end else if kd_brg[i]='224' then begin

n_brg[i]:='ABC Saus tomat 340 ml';

harga[i]:=9000;

end else if kd_brg[i]='225' then begin

n_brg[i]:='Dji sam soe kretek 12 - 1 slop';

harga[i]:=195000;

end else if kd_brg[i]='226' then begin

n_brg[i]:='Dji sam soe kotak 16 - per bungkus';

harga[i]:=22000;

end else if kd_brg[i]='227' then begin

n_brg[i]:='Gudang Garam per bungkus';

harga[i]:=11800;

end else if kd_brg[i]='228' then begin

n_brg[i]:='marlboro filter merah per bungkus';

harga[i]:=11500;

end else if kd_brg[i]='229' then begin

n_brg[i]:='marlboro menthol per bungkus';

harga[i]:=11500;

end else if kd_brg[i]='2210' then begin

n_brg[i]:='Sampoerna mild merah 16s - per bungkus';

harga[i]:=10800;

end else if kd_brg[i]='330' then begin

n_brg[i]:='sampoerna mild menthol 16s - per bungkus';

harga[i]:=10800;

end else if kd_brg[i]='331' then begin

n_brg[i]:='Johnsons kit shampo mobil 800ml';

harga[i]:=20000;

end else if kd_brg[i]='332' then begin

n_brg[i]:='Sabon lux';

harga[i]:=2500;

end else if kd_brg[i]='333' then begin

n_brg[i]:='Sabon lifebuoy';

harga[i]:=2500;

end else if kd_brg[i]='334' then begin

n_brg[i]:='Sampo  panten 1 saset';

harga[i]:=5000;

end else if kd_brg[i]='335' then begin

n_brg[i]:='Sampo rejois 1 saset';

harga[i]:=5500;

end else if kd_brg[i]='336' then begin

n_brg[i]:='pasta gigi pepsoden 120 g ';

harga[i]:=5500;

end else if kd_brg[i]='337' then begin

n_brg[i]:='korek gas warning';

harga[i]:=1500;end;

jmlharga[i]:=harga[i]*banyak[i];

totb:=totb+jmlharga[i];

diskon:=totb*0.05;

totjml:=totjml+banyak[i];

total:=totb-diskon;

end;

for i:=1 to b do

begin

writeln(i:1,n_brg[i]:20,harga[i]:30:0,banyak[i]:9:0,jmlharga[i]:15:0);

end;

writeln('==============================================================================');

writeln('jumlah barang             = ',totjml:2:0);

writeln('jumlah bayar              = Rp.',totb:2:0);

writeln('diskon                    = Rp.  ',diskon:2:0);

writeln('total bayar               = Rp.',total:2:0);

write('masukan jumlah uang       = Rp.');readln(uang);

writeln('==============================================================================');

kembalian:=uang-total;

writeln('uang kembalian            = Rp.',kembalian:2:0);

writeln;

writeln('===============================================================================');

writeln('                 TERIMA KASIH ATAS KUNJUNGANNYA')   ;

writeln('                SAMPAI JUMPA LAGI DI LAIN WAKTU ');

writeln('                    IST AKPRIND YOGYAKARTA');

write('Ada lagi pembelian baru.....??????? tekan (y/t) : ');readln(lagi);

writeln;

end;

end.

Read More

Program Toko kue Brownis

Program Toko kue Brownis

uses wincrt;

type rec_bronis=record

     rasa:string;

     harga:longint;

     stok:byte;end;

    larik_bronis=array[1..5] of rec_bronis;

type rec_jual=record

     rasa:String;harga:longint;

     jum_terjual:byte;

     Total:real;end;

     larik_jual=array[1..5] of rec_jual;

var bronis:larik_bronis;

    jual:larik_jual;

    i,j,pil,cacah:byte;

    inkam:real;

procedure isi_data_awal; {inisialisasi}

begin

     bronis[1].rasa:='coklat';bronis[1].harga:=25000;

     bronis[2].rasa:='original';bronis[2].harga:=20000;

     bronis[3].rasa:='keju';bronis[3].harga:=26500;

     bronis[4].rasa:='blueberi';bronis[4].harga:=26000;

     bronis[5].rasa:='kacang';bronis[5].harga:=24500;

for i:=1 to 5 do

begin

    jual[i].rasa:=bronis[i].rasa;

    jual[i].harga:=bronis[i].harga;

end;

end;

procedure tambah_stok(var x:larik_bronis);

var tambah_rasa:string;

    ada:boolean;

    posisi,tambah:byte;

begin

    writeln('menambah stok bronis ');

    write('masukkan rasa yang akan ditambah stok ');readln(tambah_rasa);

    {cek}

    for i:=1 to 5 do

    begin

         if (x[i].rasa=tambah_rasa) then

         begin

              ada:=true;posisi:=i;

         end;

    end;

{lakukan penambahan jika rasa ditemukan}

    if ada then

    begin

         write('masukkan jumlah tambahan stok rasa ',tambah_rasa, ' ==> ');readln(tambah);

         x[posisi].stok:=x[posisi].stok+tambah;

    end;

    if not ada then writeln('maaf rasa ',tambah_rasa,' tidak tersedia');

end;

procedure penjualan;

var rasa_jual:string;

    cacah_jual:byte;

    ada:boolean;posisi:byte;

begin

write(' mau beli rasa apa ? ');readln(rasa_jual);

{cek rasa}

for i:=1 to 5 do

    if (bronis[i].rasa=rasa_jual) then begin ada:=true;posisi:=i;end;

write('mau beli berapa banyak? ');readln(cacah_jual);

if (ada) and (bronis[posisi].stok>=cacah_jual) then       {cek stok ada}

{lakukan penjualan}

begin

     jual[posisi].jum_terjual:=jual[posisi].jum_terjual+cacah_jual;

     bronis[posisi].stok:=bronis[posisi].stok-cacah_jual;

end

else if (ada) and (bronis[posisi].stok<cacah_jual) then writeln('stok tidak cukup')

else writeln('Rasa tidak tersedia');

end;

procedure cetak_bronis(var x:larik_bronis);

begin

writeln('DAFTAR KETERSEDIAAN BRONIS DI TOKO BRONIS ENAK TENAN');

writeln;

writeln('-----------------------------------------');

writeln('NO      RASA          HARGA      STOK');

writeln('-----------------------------------------');

for i:=1 to 5 do with x[i] do

    writeln(i:2,'  ',rasa:10,'      ','Rp',harga:6,'        ',stok:3);

writeln('-----------------------------------------');

end;

procedure cetak_penjualan(var y:larik_jual);

begin

writeln('DAFTAR PENJUALAN BRONIS DI TOKO BRONIS ENAK TENAN');

writeln;

writeln('----------------------------------------------------------');

writeln('NO      RASA          HARGA   JUMLAH TERJUAL     TOTAL');

writeln('----------------------------------------------------------');

for i:=1 to 5 do with Y[i] do

begin

    total:=harga*jum_terjual;cacah:=cacah+jum_terjual;inkam:=inkam+total;

    writeln(i:2,'  ',rasa:10,'    ','Rp',harga:8,'     ',jum_terjual:4,'        ','Rp',total:8:2);

end;

writeln('-----------------------------------------------------------');

end;

procedure cek_Stok(var x:larik_bronis);

var cari:string;

    ketemu:boolean;

begin

    write('Anda ingin mengecek stok bronis rasa apa? ');readln(cari);

    for i:=1 to 5 do

    begin

        if (x[i].rasa=cari) then

         begin

              ketemu:=true;writeln ('stok rasa ',cari,' sebanyak ',x[i].stok:3,' buah');

         end;

    end;

    if not ketemu then writeln('maaf rasa ',cari,' tidak ada');

end;

   

{program utama}

begin

Isi_data_awal;

repeat

begin

     clrscr;

     writeln('TOKO BRONIS ENAK TENAN');

     writeln('coklat  keju  original blueberi kacang');

     writeln('1. Tambah stok');

     writeln('2. Cek stok berdasar rasa');

     writeln('3. Penjualan');

     writeln('4. Cetak Ketersediaan Bronis');

     writeln('5. Cetak Penjualan');

     writeln('6. Rekap Penjualan');

     writeln('7. Tutup Toko');

     write('pilih menu no : ');readln(pil);

     case pil of

     1: tambah_Stok(bronis);

     2: cek_stok(bronis);

     3: Penjualan;

     4: cetak_bronis(bronis);

     5: cetak_penjualan(jual);

     6: writeln('Hari ini telah terjual sebanyak ',cacah,' bronis,dengan pendapatan Rp',inkam:6:2);

     7: writeln('Terimakasih atas kunjungan anda');

     end;

     readln;

end

until (pil=7);

end.

Read More

Program Rental Cd

program rental Cd

uses wincrt;

type rec_cd=record

     judul:string;

     jenis:String;

     biaya:integer;stok:byte;

     end;

     array_cd=array[1..20] of rec_cd;

type rec_pinjam=record

     judul,nama:string;

     jum_hari:byte;total:longint;

     end;

     array_pinjam=array[1..20] of rec_pinjam;

var  cd,sementara:array_cd;

     peminjam:array_pinjam;

     i,j,pil,n,m:byte;

     pendapatan:longint;

procedure tambah_judul(var x:array_cd);

begin

     writeln('menambah judul baru');

     inc(n);

     write('masukkan judul cd                   : ');readln(x[n].judul);

     write('masukkan jenis (Musik,Film,Program) : ');readln(x[n].jenis);

     write('masukkan biaya sewa/hari            : ');readln(x[n].biaya);

end;

procedure tambah_Stok(var x:array_cd);

var tanya_judul:string;

    ada:boolean;

    posisi,tambah:byte;

   

begin

     write('masukkan judul yg akan ditambah/diisi stok : ');readln(tanya_judul);

     {mengecek judul di array}

     for i:=1 to n do

     begin

         if  (x[i].judul= tanya_judul) then

         begin    

                  ada:=true;posisi:=i;

         end;

     end;

     if ada=true then {jika judul sudah ada di array, lakukan penambahan stok}

     begin

          write('masukkan jumlah cd ');readln(tambah);

          x[posisi].stok:=x[posisi].stok+tambah;

     end

     else writeln('judul tersebut belum ada ');

end;

procedure peminjaman;

var pinjam_cd:string;

    tersedia:boolean;

    posisi:byte;

begin

     writeln('PEMINJAMAN CD');

     write('masukkan judul cd yang akan dipinjam ');readln(pinjam_cd);

     {mengecek ketersediaan cd di larik cd}

     for i:=1 to n do

     begin

         if (cd[i].judul=pinjam_cd) and (cd[i].stok>0) then

         begin  tersedia:=true;posisi:=i; end;

     end;

     {jika cd available lakukan peminjaman}

     if tersedia then

     begin

          inc(m);

          peminjam[m].judul:=pinjam_cd;

          write('masukkan nama peminjam = ');readln(peminjam[m].nama);

          write('berapa hari peminjaman = ');readln(peminjam[m].jum_hari);

          peminjam[m].total:=peminjam[m].jum_hari*cd[posisi].biaya;

          dec(cd[posisi].stok); {mengurangi stok}

     end

     else writeln ('Judul atau stok tidak tersedia');

end;

procedure cetak_cd(var x:array_cd);

begin

writeln('--------------------------------------------------------------');

writeln(' No     judul                  jenis   stok   biaya sewa/hari');

writeln('-------------------------------------------------------------');

for i:=1 to n do with x[i] do

    writeln(i:2,' ',judul:15,'        ',jenis:10,'    ',stok,'    ','Rp',biaya:6);

writeln('-------------------------------------------------------------');

end;

procedure sorting_cd(var x:array_cd);

var temp:rec_cd;

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].judul > sementara[j].judul) then

          begin

               temp:=sementara[i];

               sementara[i]:=sementara[j];

               sementara[j]:=temp;

          end;

     end;

end;

end;{end procedure sorting}

procedure cetak_pinjam(var y:array_pinjam);

begin

     writeln('--------------------------------------------------------------------');

     writeln(' NO   Judul CD          Peminjam     lama sewa    Total Bayar');

     writeln('--------------------------------------------------------------------');

     for i:=1 to m do with y[i] do

     begin

          pendapatan:=pendapatan+total;

         writeln(i:2,'  ',judul:15,'       ', nama:10,'    ',jum_hari:3,'     ','Rp',total:6);

     end;

     writeln('--------------------------------------------------------------------');

end;

         

begin {program utama}

repeat

begin

     clrscr;

     writeln('   RENTAL CD 5758');

     writeln('1. Tambah judul');

     writeln('2. Tambah stok cd');

     writeln('3. peminjaman');

     writeln('4. Sorting CD berdasar judul');

     writeln('5. Cetak stok CD');

     writeln('6. Cetak Peminjaman');

     writeln('7. Rekap pendapatan');

     writeln('8. Tutup ');

     writeln('Pilih menu ==> ');readln(pil);

     case pil of

     1: tambah_judul(cd);

     2: tambah_stok(cd);

     3: peminjaman;

     4: begin sorting_cd(cd);cetak_cd(sementara);end;

     5: cetak_cd (cd);

     6: cetak_pinjam(peminjam);

     7: begin

        writeln('HAri ini terjadi ',m,' peminjaman, dengan pendapatan Rp', pendapatan);

        writeln('Have a nice day');

        end;

     8: writeln('Terimakasih');

     end;

     readln;

end

until (pil=8);

end.

Read More