Membuat database pada pascal
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.
0 comments:
Post a Comment