Membuat database pada pascal

3 Comment
program penjualan;
uses crt ;

 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 judul;
begin
writeln('       KOPERASI MAHASISWA "KHARISMA KARAWANG"');
writeln('        jl. Pangkal Perjuangan KM.1 By Pass');
writeln('                    KARAWANG');
writeln('******************************************************************');
writeln;

end;

procedure tambah;
var
i:integer;
lagi:char;
begin
clrscr;
judul;
writeln('Masukan data tambahan');
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;

 writeln('Masukan nama barang yang 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]);
     writeln(' Tekan enter untuk memulai menghapus');
     readln;
     writeln(' S U K S E S ');
   end
   else
   writeln('MAAF data 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);
writeln('masukan nama data yang akan di edit [tulis dengan huruf kecil] : ');
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;
   judul;
   writeln('input dengan huruf kecil');
   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;
   writeln('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);
      writeln('DAFTAR BARANG DI ATAS Rp 1.000.000 ');
  writeln('=============================================================');
  writeln('NO   NAMA BARANG                          HARGA/S   JUMLAH   ');
  writeln('=============================================================');

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:real;
begin
repeat
clrscr;
assign(filedata,'jual.dat');
reset(filedata);
 total:=0;
 begin
judul;
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 PENJUALAN   ; ',total:3:0);
writeln;
writeln;
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('**************************');
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
  judul;
  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;
judul;
writeln('Masukan Nama Data yang di cari [tulis dengan huruf kecil] : ');
readln(datacari);
clrscr;
cari;

writeln('Apakah ingin mencari data lagi ? [y/ t] ');
readln(lagi);
writeln;
until (lagi='T')or (lagi='t');
end;


begin

repeat
clrscr;
judul;
  writeln('-- MENU --');
  writeln('************************');
  writeln('1. IN DATA BARANG');
  writeln('2. CEK DATA BARANG');
  writeln('3. CETAK DAFTAR BARANG');
  writeln('4. E X I T');
  writeln('************************');
  writeln;
writeln('Pilih Jenis Transaksi = ');
readln(nomor);
  clrscr;
case nomor of
  1:in_data_barang;
  2:cek_data_barang;
  3:cetak_daftar_barang;

end;
until nomor=4;
end.
Add a comment

3 Comment:

Program gue nih
http://last-memorie.blogspot.com/2011/05/membuat-database-pada-pascal.html

5 September 2014 pukul 06.09 comment-delete

salah nihh !! di running ga cocok

7 Januari 2016 pukul 08.22 comment-delete

minta ya thank

11 Januari 2016 pukul 12.09 comment-delete
Posting Komentar

_Pasopati 2010 UYP™

Copyright 2011 Designing a dream come true.
Blogger Templates By:Noct.