PROGRAM PENJUALAN DENGAN APLIKASI PASCAL
berikut ini listing programnya:
PROGRAM PENJUALAN;
USES
WINCRT,
WINDOS;
TYPE
TBARANG = RECORD
KDBRG : STRING[10];
NMBRG : STRING[20];
HARGABRG : STRING[25];
STOCK : STRING[5];
END;
VAR
I, HITUNG, JML_BARIS : INTEGER;
ULANGI : CHAR;
LAGI : BOOLEAN;
TEMP : STRING;
{membuat garis tebal}
PROCEDURE GARIS;
BEGIN
WRITELN ('==================================================');
END;
{menampilkan garis tipis}
PROCEDURE GARISTIPIS;
BEGIN
WRITELN ('--------------------------------------------------');
END;
{JUDUL APLIKASI}
PROCEDURE JUDUL;
BEGIN
WRITELN ('KOPERASI MAHASISWA "STMIK KHARISMA KARAWANG"');
WRITELN (' JL. PANGKAL PERJUANGAN NO. 1 BY PASS');
WRITELN (' K A R A W A N G');
WRITELN;
END;
{ DAFTAR MENU }
PROCEDURE MENU;
BEGIN
GARIS;
WRITELN ('DAFTAR PERINTAH');
WRITELN ('KODE PERINTAH KETERANGAN');
GARIS;
WRITELN ('1 INPUT DATA BARANG');
WRITELN ('2 BARANG LEBIH DARI 1 JUTA');
WRITELN ('3 CETAK DAFTAR BARANG');
WRITELN ('4 PENJUALAN');
{WRITELN ('5 LAPORAN');}
WRITELN ('5 TENTANG KAMI');
WRITELN ('0 KELUAR');
END;
{ MENAMPILKAN TENTANG KAMI }
PROCEDURE ABOUT_US;
BEGIN
GARIS;
WRITELN ('PROGRAM KOPERASI MAHASISWA');
WRITELN ('DISUSUN OLEH: ');
WRITELN ('AHMAD FAUZI, INDRIANA PUSPA ALIANSA, SITI FATIMAH,');
WRITELN ('JAMHUR ROSADA DAN ISMAIL FACHRUDIN SALEH');
WRITELN ('DISUSUN SEBAGAI TUGAS MATA KULIAH PEMROGRAMAN
TERSTRUKTUR');
WRITELN ('TEKNIK INFORMATIKA');
WRITELN ('STMIK KHARISMA KARAWANG');
WRITELN ('2015')
END;
{ FUNGSI UNTUK MERUBAH INTEGER MENJADI STRING }
FUNCTION INTTOSTR(I: LONGINT): STRING;
VAR
S: STRING[12];
BEGIN
STR(I, S);
INTTOSTR := S;
END;
{ FUNGSI UNTUK MERUBAH STRING MENJADI INTEGER }
FUNCTION STRTOINT(Z:STRING): LONGINT;
VAR
ANGKA : LONGINT;
CODE : INTEGER;
BEGIN
VAL(Z, ANGKA, CODE);
STRTOINT := ANGKA;
END;
{ MEMBUAT NO STRUCK BERDASARKAN NO BULAN + TANGGAL + JAM + MENIT }
FUNCTION NORESI:STRING;
VAR
Y, M, D, DOW : Word;
H, MIN, SEC, HSEC : word;
BEGIN
{ FUNGSI GETDATE DAN GETTIME DARI UNIT WINDOS }
GETDATE(Y,M,D,DOW);
GETTIME (H, MIN, SEC, HSEC);
NORESI:= INTTOSTR(M) + INTTOSTR(D)+ INTTOSTR(H) + INTTOSTR(MIN);
END;
{ MENAMPILKAN WAKTU SAAT INI }
FUNCTION TANGGAL:STRING;
VAR
Y, MM, DD, DOW : Word;
HH, MIN, SEC, HSEC : word;
BEGIN
GETDATE(Y,MM,DD,DOW);
GETTIME (HH, MIN, SEC, HSEC);
TANGGAL:= INTTOSTR(DD) + '.' + INTTOSTR(MM) + '.' + INTTOSTR(Y) + '-' +
INTTOSTR(HH) + ':' + INTTOSTR(MIN);
END;
{ FUNGSI UNTUK MEMERIKSA KEBERADAAN BARANG }
FUNCTION CEKBARANG(S:STRING):BOOLEAN;
VAR
DAFTAR : STRING;
X, Y, Z : INTEGER;
FCHECK : TEXT;
KETEMU : BOOLEAN;
BEGIN
ASSIGN (FCHECK, 'data\[Link]');
RESET (FCHECK);
X:=1;
Y:=1;
Z:=1;
KETEMU := FALSE;
WHILE NOT EOF(FCHECK) DO
BEGIN
READLN (FCHECK, DAFTAR);
IF (X>1) AND (X MOD 4 = 1) THEN
BEGIN
Z:=Z+1;
Y:=1;
END
ELSE IF (X=1) THEN
Y:=1
ELSE
Y:=Y+1;
IF (Y=1) THEN
BEGIN
IF DAFTAR = S THEN
BEGIN
CEKBARANG := TRUE;
KETEMU := TRUE;
END
ELSE
BEGIN
IF KETEMU = FALSE THEN
CEKBARANG := FALSE;
END;
END;
X:=X+1;
END;
CLOSE (FCHECK);
END;
{ PROSEDUR UNTUK MEMERIKSA KEBERADAAN NO RESI }
FUNCTION CEKRESI(R:STRING):BOOLEAN;
VAR
DAFTAR : STRING;
FCHECK : TEXT;
KETEMU : BOOLEAN;
BEGIN
ASSIGN (FCHECK, 'data\[Link]');
RESET (FCHECK);
KETEMU := FALSE;
WHILE NOT EOF(FCHECK) DO
BEGIN
READLN (FCHECK, DAFTAR);
IF DAFTAR = R THEN
BEGIN
CEKRESI := TRUE;
KETEMU := TRUE;
END
ELSE
BEGIN
IF KETEMU = FALSE THEN
CEKRESI := FALSE;
END;
END;
CLOSE (FCHECK);
END;
{ FUNGSI UNTUK MENGHITUNG JUMLAH BARIS PADA FILE [Link] }
PROCEDURE HITUNG_BARIS(LOK:STRING);
VAR
G : TEXT;
JUMLAH : INTEGER;
DAFTAR : STRING;
BEGIN
JUMLAH := 0;
ASSIGN (G, LOK);
RESET (G);
WHILE NOT EOF(G) DO
BEGIN
READLN (G, DAFTAR);
JUMLAH:=JUMLAH+1;
END;
CLOSE (G);
JML_BARIS:=JUMLAH;
END;
{ PROSEDUR UNTUK INPUT DATA BARANG }
PROCEDURE IN_DATA_BARANG;
VAR
TAMBAH: BOOLEAN;
JUMLAH : INTEGER;
TEMP, LOKASI, DAFTAR, STOCK : STRING;
NAKHIR : REAL;
HARGA : LONGINT;
F : TEXT;
BEGIN
{ VAR TAMBAH SEBAGAI KONTROLER PERULANGAN }
TAMBAH := TRUE;
LOKASI := 'data\[Link]';
HITUNG_BARIS(LOKASI);
{ MENCARI JUMLAH BARANG YANG SUDAH ADA }
NAKHIR := (JML_BARIS/4);
ASSIGN (F, LOKASI);
APPEND (F);
WHILE (TAMBAH=TRUE) DO
BEGIN
{ INPUT BARANG SELAMA INPUTAN BUKAN X }
WRITE ('MASUKAN NAMA BARANG [X SELESAI] :'); READLN(TEMP);
IF (TEMP <> 'X') THEN
BEGIN
NAKHIR := NAKHIR+1;
WRITELN (F,NAKHIR:0:0);
WRITELN (F,TEMP);
WRITE ('MASUKAN HARGA :Rp.'); READLN(HARGA);
WRITELN (F, HARGA);
WRITE ('MASUKAN STOCK:'); READLN(STOCK);
WRITELN (F, STOCK);
GARISTIPIS;
END
ELSE
TAMBAH := FALSE;
{ SAAT NILAI INPUTAN X MAKA PERULANGAN DIHENTIKAN }
END;
CLOSE (F);
END;
{ PROSEDUR UNTUK MENCETAK DAFTAR BARANG }
PROCEDURE CETAK_DAFTAR_BARANG(CETAK:STRING);
TYPE
TEMPBRG = RECORD
KDBRG : STRING[10];
NMBRG : STRING[20];
HARGABRG : STRING[25];
STOCK : STRING[5];
END;
VAR
F, G : TEXT;
DAFTAR, PERINTAH, LOKASI : STRING;
I, J, V, W, X, Y, Z, CODE, KORBAN, STOCK : INTEGER;
ANGKA, JML, ASET : LONGINT;
BRG : ARRAY [1..50] OF TBARANG;
TEMPB : TEMPBRG;
EDIT : BOOLEAN;
BEGIN
CLRSCR;
LOKASI := 'data\[Link]';
ASSIGN (F, LOKASI);
RESET (F);
X:=1;
Y:=1;
W:=1;
V:=1;
WHILE NOT EOF(F) DO
BEGIN
READLN (F, DAFTAR);
IF (W>1) AND (W MOD 4 = 1) THEN
BEGIN
Y:=Y+1;
X:=1;
END
ELSE IF (W=1) THEN
X:=1
ELSE
X:=X+1;
IF (X=1) THEN
BRG[Y].KDBRG := DAFTAR;
IF (X=2) THEN
BRG[Y].NMBRG := DAFTAR;
IF (X=3) THEN
BRG[Y].HARGABRG := DAFTAR;
IF (X=4) THEN
BRG[Y].STOCK := DAFTAR;
W:=W+1;
END;
GOTOXY(1,1); WRITE ('JUMLAH DATA: ', Y);
GOTOXY(1,2); GARIS;
GOTOXY(1,3); WRITELN ('| NOID | NAMA BARANG | HARGA BARANG | STOCK
|');
GOTOXY(1,4); GARISTIPIS;
ASET:=0;
JML:=0;
{ JIKA VAR CETAK BERNILAI 'JUTA' MAKA HANYA AKAN DITAMPILKAN BARANG
DENGAN HARGA > 1000000 }
IF (CETAK='JUTA') THEN
BEGIN
FOR Z := 1 TO Y DO
BEGIN
VAL(BRG[Z].HARGABRG, ANGKA, CODE);
VAL(BRG[Z].STOCK, STOCK, CODE);
IF (STRTOINT(BRG[Z].HARGABRG) >= 1000000) THEN
BEGIN
GOTOXY(1, 4+V); WRITE ('| ',BRG[Z].KDBRG:4,' | ',BRG[Z].NMBRG:2);
GOTOXY(24, 4+V); WRITE (' | Rp.', ANGKA);
GOTOXY(39, 4+V); WRITELN (' | ', STOCK,' |');
V:=V+1;
JML := JML + STOCK;
ASET := ASET + (ANGKA*STOCK);
END;
END;
END
ELSE
BEGIN
FOR Z := 1 TO Y DO
BEGIN
VAL(BRG[Z].HARGABRG, ANGKA, CODE);
VAL(BRG[Z].STOCK, STOCK, CODE);
GOTOXY(1, 4+Z); WRITE ('| ',BRG[Z].KDBRG:4,' | ',BRG[Z].NMBRG:2);
GOTOXY(24, 4+Z); WRITE (' | Rp.', ANGKA);
GOTOXY(39, 4+Z); WRITELN (' | ', BRG[Z].STOCK,' |');
JML := JML + STOCK;
ASET := ASET + (ANGKA*STOCK);
END;
END;
GARIS;
WRITELN ('TOTAL JUMLAH BARANG :',JML);
WRITELN ('TOTAL ASET :Rp.',ASET);
GARIS;
EDIT := TRUE;
WHILE (EDIT = TRUE) DO
BEGIN
WRITE ('OPERASI [D:DELETE, U:UPDATE, X:KELUAR]:'); READLN(PERINTAH);
GARISTIPIS;
IF (PERINTAH = 'U') THEN
BEGIN
WRITE ('MASUKAN NO ITEM YANG AKAN DI RUBAH:'); READLN(KORBAN);
FOR J:= 1 TO Y DO
BEGIN
IF BRG[J].KDBRG = INTTOSTR(KORBAN) THEN
KORBAN := J;
END;
GARISTIPIS;
WRITELN ('NAMA BARANG SEBELUMNYA :', BRG[KORBAN].NMBRG);
WRITE ('NAMA BARU :'); READLN([Link]);
GARISTIPIS;
WRITELN ('HARGA BARANG SEBELUMNYA :', BRG[KORBAN].HARGABRG);
WRITE ('HARGA BARU :'); READLN([Link]);
GARISTIPIS;
WRITELN ('STOCK SEBELUMNYA :', BRG[KORBAN].STOCK);
WRITE ('STOCK BARU :'); READLN([Link]);
BRG[KORBAN].KDBRG := INTTOSTR(KORBAN);
BRG[KORBAN].NMBRG := [Link];
BRG[KORBAN].HARGABRG := [Link];
BRG[KORBAN].STOCK := [Link];
END
ELSE IF (PERINTAH = 'D') THEN
BEGIN
WRITE ('MASUKAN NO ITEM YANG AKAN DI HAPUS:');READLN(KORBAN);
FOR J:= 1 TO Y DO
BEGIN
IF BRG[J].KDBRG = INTTOSTR(KORBAN) THEN
KORBAN := J;
END;
{ MENANDAI NILAI YANG DI HAPUS }
BRG[KORBAN].KDBRG := '';
BRG[KORBAN].NMBRG := 'DELETE';
BRG[KORBAN].HARGABRG := '';
BRG[KORBAN].STOCK := '';
END
ELSE IF (PERINTAH = 'X') THEN
BEGIN
EXIT;
END
ELSE
BEGIN
WRITELN ('PERINTAH TIDAK DITEMUKAN...');
READLN;
EXIT;
END;
CLOSE (F);
{ HAPUS FILE [Link] KEMUDIAN BUAT ULANG DAN ISI DENGAN NILAI
ARRAY YANG SUDAH DIUPDATE }
ASSIGN (G, LOKASI);
ERASE(G);
REWRITE (G);
FOR I := 1 TO Y DO
BEGIN
{ AGAR BARANG YANG DI DELETE TIDAK DITULIS DALAM FILE }
IF (BRG[I].NMBRG <> 'DELETE') THEN
BEGIN
WRITELN (G, BRG[I].KDBRG);
WRITELN (G, BRG[I].NMBRG);
WRITELN (G, BRG[I].HARGABRG);
WRITELN (G, BRG[I].STOCK);
END;
END;
WRITELN('PERINTAH BERHASIL DILAKSANAKAN....');
CLOSE (G);
END;
READLN;
END;
PROCEDURE TRANSAKSI;
TYPE
TBRGTEMP = RECORD
NMBRG : STRING[20];
HARGABRG : LONGINT;
JUMLAH : INTEGER;
END;
VAR
K, L : INTEGER;
F : TEXT;
PILIH, NOWRESI, LOK, TEMP : STRING;
HARGA, TUNAI : LONGINT;
PPN : REAL;
ULANG : BOOLEAN;
{ FOOTHER STRUCK }
PROCEDURE FOOTHER;
BEGIN
WRITELN (' HARGA SUDAH TERMASUK PAJAK');
WRITELN ('***TERIMA KASIH & SELAMAT BELANJA KEMBALI***');
WRITELN (' [Link]');
END;
{ PROSEDUR JUALAN }
PROCEDURE JUALAN;
VAR
LAGI : BOOLEAN;
I, J, X, Y, Z, CARI : INTEGER;
BRG : ARRAY [1..40] OF TBARANG;
BRGTEMP : ARRAY [1..20] OF TBRGTEMP;
GRAND : LONGINT;
FCHECK, RESI : TEXT;
DAFTAR, TEMPCARI : STRING;
BEGIN
K:=1;
LAGI := TRUE;
GRAND:= 0;
NOWRESI := NORESI;
WRITELN ('NO RESI :', NOWRESI);
LOK := ('data\[Link]');
ASSIGN (FCHECK, LOK);
RESET (FCHECK);
X:=1;
Y:=1;
Z:=1;
WHILE NOT EOF(FCHECK) DO
BEGIN
READLN (FCHECK, DAFTAR);
IF (X>1) AND (X MOD 4 = 1) THEN
BEGIN
Z:=Z+1;
Y:=1;
END
ELSE IF (X=1) THEN
Y:=1
ELSE
Y:=Y+1;
IF (Y=1) THEN
BRG[Z].KDBRG := DAFTAR;
IF (Y=2) THEN
BRG[Z].NMBRG := DAFTAR;
IF (Y=3) THEN
BRG[Z].HARGABRG := DAFTAR;
IF (Y=4) THEN
BRG[Z].STOCK := DAFTAR;
X:=X+1;
END;
CLOSE (FCHECK);
ASSIGN (RESI, 'data\' + NOWRESI + '.txt');
REWRITE (RESI);
WHILE (LAGI = TRUE) DO
BEGIN
WRITE ('MASUKAN KODE BARANG [X SELESAI] :'); READLN(TEMPCARI);
IF (TEMPCARI <> 'X') THEN
BEGIN
FOR J:= 1 TO Z DO
BEGIN
IF (BRG[J].KDBRG = TEMPCARI) THEN
CARI := J;
END;
IF (CEKBARANG(TEMPCARI) = TRUE) THEN
BEGIN
WRITELN ('NAMA BARANG :', BRG[CARI].NMBRG);
BRGTEMP[K].NMBRG := BRG[CARI].NMBRG;
WRITELN ('HARGA :Rp.', BRG[CARI].HARGABRG);
BRGTEMP[K].HARGABRG := STRTOINT(BRG[CARI].HARGABRG);
WRITE ('BANYAKNYA :'); READLN(BRGTEMP[K].JUMLAH);
BRG[CARI].STOCK := INTTOSTR(STRTOINT(BRG[CARI].STOCK) -
BRGTEMP[K].JUMLAH);
GARISTIPIS;
WRITELN (RESI, BRGTEMP[K].NMBRG);
WRITELN (RESI, INTTOSTR(BRGTEMP[K].HARGABRG));
WRITELN (RESI, INTTOSTR(BRGTEMP[K].JUMLAH));
K:=K+1;
END
ELSE
BEGIN
WRITELN ('KODE BARANG TIDAK DITEMUKAN...');
READLN;
END;
END
ELSE IF (TEMPCARI = 'X' ) THEN
BEGIN
LAGI := FALSE;
END;
END;
CLOSE (RESI);
{ PROSEDUR UNTUK MENYIMPAN NO STRUK PADA FILE }
ASSIGN (F, 'data\[Link]');
APPEND (F);
WRITELN (F,NOWRESI);
CLOSE (F);
GARISTIPIS;
CLRSCR;
JUDUL;
GOTOXY(1,4); GARIS;
GOTOXY(1,5); WRITE ('NO STRUCK:', NOWRESI, ' ', TANGGAL);
GOTOXY(1,6); GARISTIPIS;
GOTOXY(1,7); WRITE ('| NAMA BARANG | HARGA | JUMLAH | TOTAL |');
GOTOXY(1,8); GARISTIPIS;
FOR I := 1 TO (K-1) DO
BEGIN
GOTOXY(1, 8+I); WRITE ('| ',BRGTEMP[I].NMBRG);
GOTOXY(20, 8+I); WRITE ('| ',BRGTEMP[I].HARGABRG:2);
GOTOXY(31, 8+I); WRITE ('| ',BRGTEMP[I].JUMLAH:2);
GOTOXY(41, 8+I); WRITE ('|
',BRGTEMP[I].HARGABRG*BRGTEMP[I].JUMLAH,' |');
GRAND := GRAND + (BRGTEMP[I].HARGABRG*BRGTEMP[I].JUMLAH);
END;
WRITELN;
GARISTIPIS;
WRITELN ('TOTAL :Rp.',GRAND);
WRITE ('TUNAI :Rp.'); READLN(TUNAI);
WRITELN ('KEMBALI :Rp.',TUNAI-GRAND);
WRITELN;
GARIS;
FOOTHER;
{ UPDATE JUMLAH STOCK TIAP BARANG }
ASSIGN (FCHECK, LOK);
ERASE(FCHECK);
REWRITE (FCHECK);
FOR I := 1 TO Z DO
BEGIN
WRITELN (FCHECK, BRG[I].KDBRG);
WRITELN (FCHECK, BRG[I].NMBRG);
WRITELN (FCHECK, BRG[I].HARGABRG);
WRITELN (FCHECK, BRG[I].STOCK);
END;
CLOSE (FCHECK);
READLN;
END;
{ PROSEDUR UNTUK MELIHAT DATA DARI SUATU STRUCK }
PROCEDURE VIEW_RESI;
TYPE
TBARANG = RECORD
NMBRG : STRING[10];
JMBRG : STRING[20];
HARGABRG : STRING[25];
END;
VAR
NOCARI, LOKASI : STRING;
F : text;
DAFTAR : STRING;
W, X,Y,Z, ANGKA, CODE : INTEGER;
BRG : ARRAY [1..25] OF TBARANG;
BEGIN
WRITE ('MASUKAN NO RESI YANG AKAN DICARI:'); READ(NOCARI);
IF (CEKRESI(NOCARI) = TRUE) THEN
BEGIN
LOKASI := 'data\'+NOCARI+'.txt';
ASSIGN (F, LOKASI);
RESET (F);
X:=1;
Y:=1;
W:=1;
WHILE NOT EOF(F) DO
BEGIN
READLN (F, DAFTAR);
IF (W>1) AND (W MOD 3 = 1) THEN
BEGIN
Y:=Y+1;
X:=1;
END
ELSE IF (W=1) THEN
X:=1
ELSE
X:=X+1;
IF (X=1) THEN
BRG[Y].NMBRG := DAFTAR;
IF (X=2) THEN
BRG[Y].HARGABRG := DAFTAR;
IF (X=3) THEN
BRG[Y].JMBRG := DAFTAR;
W:=W+1;
END;
CLOSE (F);
CLRSCR;
GOTOXY(1,1); GARIS;
GOTOXY(1,2); WRITELN ('| NO | NAMA BARANG | HARGA | JUMLAH |');
GARISTIPIS;
FOR Z := 1 TO Y DO
BEGIN
GOTOXY(1 ,3+Z); WRITELN ('| ',Z,'. ');
GOTOXY(6 ,3+Z); WRITELN ('| ',BRG[Z].NMBRG);
GOTOXY(24,3+Z); WRITELN ('| ',BRG[Z].HARGABRG);
GOTOXY(38,3+Z); WRITELN ('| ',BRG[Z].JMBRG,' |');
END;
GARIS;
END
ELSE
BEGIN
WRITELN ('DATA TIDAK DITEMUKAN');
READLN;
END;
READLN;
END;
BEGIN
CLRSCR;
ULANG := TRUE;
WHILE (ULANG=TRUE) DO
BEGIN
CLRSCR;
WRITELN ('1. TRANSAKSI');
WRITELN ('2. LIHAT RESI');
WRITELN ('X. KEMBALI KE MENU UTAMA');
GARIS;
WRITE ('MASUKAN PILIHAN:'); READLN(PILIH);
IF (PILIH = '1') THEN
JUALAN
ELSE IF (PILIH = '2') THEN
BEGIN
VIEW_RESI;
READLN;
END
ELSE IF (PILIH = 'X') OR (PILIH = 'x') THEN
ULANG:=FALSE;
END;
END;
{PROGRAM UTAMA}
BEGIN
LAGI := TRUE;
WHILE (LAGI = TRUE) DO
BEGIN
CLRSCR;
JUDUL;
MENU;
GARIS;
TEMP := '';
WRITE ('MASUKAN PERINTAH :'); READLN(TEMP);
IF (TEMP='1') THEN
BEGIN
IN_DATA_BARANG;
END
ELSE IF (TEMP='2') THEN
BEGIN
CETAK_DAFTAR_BARANG('JUTA');
END
ELSE IF (TEMP='3') THEN
BEGIN
CETAK_DAFTAR_BARANG('');
END
ELSE IF (TEMP='4') THEN
BEGIN
TRANSAKSI;
END
{ELSE IF (TEMP='5') THEN
BEGIN
WRITELN ('LAPORAN');
READLN;
END}
ELSE IF (TEMP='5') THEN
BEGIN
ABOUT_US;
READLN;
END
ELSE IF (TEMP='0') THEN
BEGIN
LAGI := FALSE;
END
ELSE
BEGIN
WRITELN ('PERINTAH TIDAK DITEMUKAN :');
READLN;
END;
END;
END.