* Penggajian *
clssetcolor("w+/b+")
@5,10 clea to 20,60
@5,10 to 20,60
@9,11 to 9,59 doub
a="PT.YASSIR CORPORATION"
b="Jalan Diponegoro no.5 jakarta pusat"
c="Laporan penggajian karyawan"
@6,40-len(a)/2 say a
@7,40-len(b)/2 say b
@8,40-len(c)/2 say c
Nip=space(3)
nama=space(20)
gol=space(2)
status=space(2)
@10,11 say"Nip pegawai :"
@11,11 say"Nama pegawai :"
@12,11 say"Golongan pegawai :"
@13,11 say"Status pegawai :"
@14,11 say"Gaji pokok pegawai :"
@15,11 say"Tunjangan pegawai :"
@16,11 say"Gaji bersih pegawai :"
x=col()
@10,x get nip
@11,x get nama
@12,x get gol
@13,x get status
read
if status ="k"
ket="kawin"
else
ket="belum kawin"
endif
@13,x say ket
if gol="a"
gaji=1000000
elseif gol="b"
gaji=800000
elseif gol="c"
gaji=600000
else
gaji=400000
endif
@14,x say gaji
if status="k"
tunj=10/100*gaji
else
tunj=0
endif
gajibersih=gaji+tunj
@15,x say tunj
@16,x say gajibersih
* Penginputan *
*------------------------------------*
* Program InputB.Prg *
* Input Data Barang Baru *
*------------------------------------*
cls
#include "inkey.ch"
MJudul:="INPUT DATA BARANG BARU"
set confirm on
do while .T.
@ 8,15 to 17,65
setcolor("w/b,gr+/bg")
@ 9,39-len(MJudul)/2 say MJudul
@ 10,16 say repl(chr(196),49)
MKdbr :=space(5)
MJenbar :=space(25)
MNabar :=space(25)
MSatuan :=space(20)
MHbeli :=0
MHjual :=0
@ 11,20 say "Kode Barang : "
@ 12,20 say "Jenis Barang : "
@ 13,20 say "Nama Barang : "
@ 14,20 say "Satuan : "
@ 15,20 say "Harga Beli : "
@ 16,20 say "Harga Jual : "
x=col()
If Lastkey()=27
exit
Endif
@ 11,x get MKdbr pict "@! AA.99"
read
if empty(Mkdbr)
alert('Kode Barang jangan dikosongkan ....!!!')
Loop
endif
use barang.dbf
index on kdbr to skdbr.ntx
Dbseek(Mkdbr)
If found()
@ 12,x Say Jenbar pict "@!"
@ 13,x Say Nabar pict "@!"
@ 14,x Say Satuan pict "@!"
@ 15,x Say Hbeli pict "Rp 99,999"
@ 16,x say Hjual pict "Rp 99,999"
alert('Kode Barang sudah pernah diinput...!!!!')
loop
Endif
save screen to layarz
@ 11,44 to 17,64
setcolor("w+/b+,gr+/bg+")
DO WHILE .T.
A={'OBAT-OBATAN','PERALATAN RUMAH','PERALATAN KANTOR','PERALATAN SEKOLAH','ELEKTRONIK'}
PIL=ACHOICE(12,45,16,63,A)
IF PIL = 1
MJENBAR = 'OBAT-OBATAN'
EXIT
ELSEIF PIL = 2
MJENBAR = 'PERALATAN RUMAH'
EXIT
ELSEIF PIL = 3
MJENBAR = 'PERALATAN KANTOR'
EXIT
ELSEIF PIL = 4
MJENBAR = 'PERALATAN SEKOLAH'
EXIT
ELSEIF PIL = 5
MJENBAR = 'ELEKTRONIK'
EXIT
ENDIF
ENDDO
rest screen from layarz
SETCOLOR("GR+/BG+")
@12,X SAY MJENBAR PICT "@!"
@13,X GET MNABAR PICT "@!"
@14,X GET MSATUAN PICT "@!"
@15,X GET MHBELI PICT "Rp 99,999,999"
READ
MHJUAL := MHBELI + (0.2 * MHBELI)
@16,X SAY MHJUAL PICT "Rp 99,999,999"
BENAR =SPACE(1)
@ 19,15 to 21,65
setcolor("W/B,BR+*/BG**")
DO WHILE .NOT. BENAR $ 'YT'
@20,16 SAY 'DATA SUDAH BENAR :' GET BENAR PICT"!"
READ
ENDDO
IF BENAR = 'Y'
DBAPPEND()
REPL KDBR WITH MKDBR
REPL JENBAR WITH MJENBAR
REPL NABAR WITH MNABAR
REPL SATUAN WITH MSATUAN
REPL HBELI WITH MHBELI
REPL HJUAL WITH MHJUAL
ENDIF
LAGI = SPACE(1)
@ 19,15 to 21,65
setcolor("W/B,BR+*/R**")
DO WHILE .NOT. LAGI $'YT'
@20,16 SAY "INPUT DATA LAGI NGGAK LAE :"GET LAGI PICT"!"
READ
ENDDO
IF LAGI ='Y'
REST SCREEN FROM LAYARZ
LOOP
ELSE
REST SCREEN FROM LAYARZ
EXIT
ENDIF
ENDDO
REST SCREEN FROM LAYARZ
SETCOLOR (MCOLOR)
RETURN
do while.t.
cls
set confirm on
setcolor("w+/r+")
@1,1 clea to 17,79
@1,1 to 17,79 doub
@3,2 to 3,78
@6,2 to 6,78
@8,2 to 8,78
@2,35 say "input penjualan barang"
@4,5 say" nomor faktur :"
@5,5 say" tanggal jual :"
a=col()
@7,5 say "no kode barang namabarang harga jumlah total"
use jual1
go Bottom
xnofak=nofak+1
xtgljual=date()
xgrand=0
brs=9
no=1
@4,a say nofak
@5,a say Xtgljual
@18,40 say"grand total :"
@19,40 say"bayar :"
@20,40 say"kembalian :"
b=col()
do while.t.
use barang
index on kobar to barang.ntx
xkobar=space(3)
@brs,4 say no pict"99"
@brs,21 get xkobar
read
dbseek(xkobar)
if ! found()
alert("kode barang tidak ada")
loop
endif
@brs,38 say nabar
xHjual=Hbeli*1.1
@brs,54 say xhjual pict"999,999,999"
do while.t.
use barang
xjlh=0
@brs,65 get xjlh pict"99"
read
if Xjlh>(barang->stock)
alert("stok barang kurang")
loop
else
exit
endif
enddo
xtotal=xhjual*xjlh
xgrand=xgrand+xtotal
@brs,80 say xtotal pict"999,999,999"
@18,b say xgrand pict"999,999,999"
@21,1 clea to 23,79
@21,1 to 23,79
lagi=space(1)
@22,5 say"ada barang lagi :"get lagi pict"!"
read
if lagi="Y"
brs=brs+1
no=no+1
use jual1
dbappend()
repl nofak with xnofak
repl tgljual with xtgljual
repl kobar with xkobar
repl hjual with xhjual
repl jlh with xjlh
repl total with xtotal
use barang
index on kobar to barang.ntx
repl stock with (barang->stock)-xjlh
loop
else
exit
endif
enddo
do while.t.
bayar=0
@19,b get bayar pict"999,999,999"
read
if bayar<xgrand
alert("uangmu kurang")
loop
else
exit
endif
enddo
kembali=bayar-xgrand
@20,b say kembali pict"999,999,999"
ulang=space(1)
@21,1 clea to 23,79
@21,1 to 23,79
@22,5 say "masih ada pembeli?!" get ulang pict"!"
read
if ulang="Y"
loop
else
exit
endif
enddo
*Program Membuat Menu Utama*
#include "inkey.ch"
local Pil, Frame:=repl(chr(177),9), Clr, Scr
SETCOLOR('N+/N+')
frame:=Repl(chr(178),9)
@00,00,23,79 box frame
set score off
set date italian
set wrap on
set cent on
set message to 23 center
set color to r+/r+
@1,0 say space(80)
setcolor("b+/g+")
dispbox(2,0,23,79,Frame)
@24,0 say space(80)
@24,0 say "Esc->Exit"
@0,0 say space(80)
@0,0 say repl(chr(254),80)
setcolor("W+/R+,gr+/Bg")
@23,0 clear to 23,79
do SBox with 10,05,14,75,"g+/b+"
X='SISTEM INFORMASI PENJUALAN BARANG'
Y='PADA PT.Y@ssir corpor@tion.Tbc'
Z='Jl.Melati No. 259 Medan - Telp.(061)3456345 BY:Yassir rangkuti'
@11,40-len(x)/2 say x
@12,40-len(y)/2 say y
@13,40-len(z)/2 say z
*---------Supplier---------------
if ! file("skdsp.ntx")
use supplier
Index on kdsp to skdsp
endif
if ! file("Skdbr.ntx")
use Barang
Index on kdbr to Skdbr
endif
if ! file("SBeli.ntx")
use Beli
Index on (Nofak+Kdsp+Kdbr) to SBeli
endif
if ! file("SJual.ntx")
use Jual
Index on (Nofak+Kdbr) to SJual
endif
Select 1
use Supplier index SKdSp
Select 2
use Barang index SKdbr
Select 3
use Beli index SBeli
Select 4
use Jual index SJual
do while .T.
setcolor('w+/r+,w+/b+*')
@1,3 prompt " File " mess "File Untuk Input, Edit, Cari & Hapus Data Supplier dan Barang "
@1,18 prompt " Transaksi " mess "Penginputan Data-data Pembelian dan Penjualan Barang "
@1,35 prompt " Laporan " mess "Pencetakan Data Barang, Supplier, Pembelian dan Penjualan "
menu to Pil
do case
case Pil=0
Scr:=savescreen()
Clr:=setcolor()
do SBox with 10,20,14,60,"w+/b,gr+/br"
@ 11,23 say "Betul akan keluar dari program?"
@ 12,21 say repl(chr(285),39)
@ 13,25 prompt " Ya "
@ row(),50 prompt "Tidak"
menu to Pil
restscreen(,,,,Scr)
setcolor(Clr)
if Pil=1
exit
endif
case Pil=1
do MFile
case Pil=2
do Transaksi
case Pil=3
do Laporan
endcase
enddo
setcolor("")
cls
tone(700,5)
tone(300,1)
cls
return
proc RKey
keyboard chr(K_ESC) + chr(K_RIGHT) + chr(K_ENTER)
return
proc LKey
keyboard chr(K_ESC) + chr(K_LEFT) + chr(K_ENTER)
return
*************--Kumpulan Procedure--*************
*Program Mfile
*Menu Mfile
Procedure Mfile
local MScreen:=savescreen(),MColor:=setcolor(), Pil
do while .T.
set key K_RIGHT to RKey
set key K_LEFT to LKey
do Sbox with 3,3,6,17,"n/bg,gr+/b"
@4,4 prompt "A. Supplier "
@5,4 prompt "B. Barang "
menu to Pil
set key K_RIGHT to
set key K_LEFT to
do case
case Pil=0
exit
case Pil=1
do Supplier
case Pil=2
do Barang
endcase
enddo
restscreen(,,,,MScreen)
setcolor(MColor)
return
* Program Transaksi
*Menu Transaksi
Procedure Transaksi
local MScreen:=savescreen(),MColor:=setcolor(), Pil
do while .T.
set key K_RIGHT to RKey
set key K_LEFT to LKey
do Sbox with 3,18,6,33,"n/bg,gr+/b"
@4,19 prompt "A. Pembelian "
@5,19 prompt "C. Penjualan "
menu to Pil
set key K_RIGHT to
set key K_LEFT to
do case
case Pil=0
exit
case Pil=1
do Beli
case Pil=2
do Jual
endcase
enddo
restscreen(,,,,MScreen)
setcolor(MColor)
return
*Program Laporan
*Menu Laporan
Procedure Laporan
local MScreen:=savescreen(),MColor:=setcolor(), Pil
set deleted on
do while .T.
set key K_RIGHT to RKey
set key K_LEFT to LKey
do Sbox with 3,35,8,52,"n/bg,gr+/b"
@4,36 prompt "A. Barang "
@5,36 prompt "B. Supplier "
@6,36 prompt "C. Pembelian "
@7,36 prompt "D. Penjualan "
menu to Pil
set key K_RIGHT to
set key K_LEFT to
do case
case Pil=0
exit
case Pil=1
do CBarangS
case Pil=2
*do LapSupp
case Pil=3
do LapBeli
case Pil=4
do LapJual
endcase
enddo
set deleted off
restscreen(,,,,MScreen)
setcolor(MColor)
return
*Program Supplier
*Menu Supplier
Procedure Supplier
local MScreen:=savescreen(), MColor:=setcolor(), Pil
Save screen To Layarx
set confirm on
do while .T.
do SBox with 5,10,9,27,"w+/g,gr+/br"
@6,11 prompt "A. Input "
@7,11 prompt "B. Edit "
@8,11 prompt "C. Cari & Hapus"
menu to Pil
do case
case Pil=0
exit
case Pil=1
do InputS
case Pil=2
do EditS
case Pil=3
do CariS
end case
enddo
restscreen(,,,,MScreen)
setcolor(MColor)
return
*Program Barang
*Menu Barang
Procedure Barang
local MScreen:=savescreen(), MColor:=setcolor(), Pil
Save screen To Layarx
set confirm on
do while .T.
do SBox with 6,10,10,27,"w+/g,gr+/br"
@7,11 prompt "A. Input "
@8,11 prompt "B. Edit "
@9,11 prompt "C. Cari & Hapus"
menu to Pil
do case
case Pil=0
exit
case Pil=1
do InputB
case Pil=2
* do EditB
case Pil=3
* do CariB
end case
enddo
restscreen(,,,,MScreen)
setcolor(MColor)
return
*Program LapBeli
*Menu Laporan Pembelian
Procedure LapBeli
local MScreen:=savescreen(), MColor:=setcolor(), Pil
Save screen To Layarx
set confirm on
do while .T.
do SBox with 6,54,11,73,"w+/g,gr+/br"
@07,55 prompt "A. Per Bulan "
@08,55 prompt "B. Per Tahun "
@09,55 prompt "C. Per No. Faktur "
@10,55 prompt "D. Keseluruhan "
menu to Pil
do case
case Pil=0
exit
case Pil=1
* do BeliBln
case Pil=2
* do BeliThn
case Pil=3
* do BeliFak
case Pil=4
do BeliSel
end case
enddo
restscreen(,,,,MScreen)
setcolor(MColor)
return
*Program LapJual
*Menu Laporan Penjualan
Procedure LapJual
local MScreen:=savescreen(), MColor:=setcolor(), Pil
Save screen To Layarx
set confirm on
do while .T.
do SBox with 7,54,11,73,"w+/g,gr+/br"
@08,55 prompt "A. Per Bulan "
@09,55 prompt "B. Per Tahun "
@10,55 prompt "C. Per No. Faktur "
menu to Pil
do case
case Pil=0
exit
case Pil=1
do JualBln
case Pil=2
* do JualThn
case Pil=3
do JualFak
end case
enddo
restscreen(,,,,MScreen)
setcolor(MColor)
return
proc SBox(T,L,B,R,Warna)
local V,H,I
V=savescreen(T+1,R+1,B+1,R+2)
H=savescreen(B+1,L+2,B+1,R+2)
for I:=2 to len(H) step 2
H:=stuff(H,I,1,chr(7))
next I
for I:=2 to len(V) step 2
V=stuff(V,I,1,chr(7))
next I
setcolor(Warna)
@T,L clear to B,R
@T,L to B,R
restscreen(T+1,R+1,B+1,R+2,V)
restscreen(B+1,L+2,B+1,R+2,H)
return
*Laporan Penjualan Barang Per No.Faktur*
#include "inkey.ch"
local MScreen:=savescreen(), MColor:=setcolor(), Pil
Save screen To Layarx
set confirm on
SetCursor(3)
Do while .T.
xNofak=space(5)
Do sbox with 5,5,7,75,'w+/b+'
@6,7 say 'Masukkan No. Faktur yang akan dicetak :'
x=col()
@6,x get xNofak Pict'99999'
read
if empty(xNofak)
alert('No. Faktur jangan dikosongkan....!!!!!!!')
Rest screen from layarx
Retu
endif
select 4
index on Nofak to Faktur
use Jual index Faktur
Dbseek(xNofak)
if ! found()
alert('data tidak ada..!!!')
Rest screen from layarx
Retu
endif
Tanya=space(1)
Do while .not. Tanya $'MP'
Do sbox with 5,5,7,75,'w+/b+'
@6,7 say 'Cetak Ke Monitor/Printer [M/P] :'
x=col()
@6,x get tanya Pict'!'
read
Enddo
If tanya='M'
Set Device to screen
else
If ! IsPrinter()
Alert('Printer tidak Aktif.......!!!!!')
Rest screen from layarx
Retu
else
Set printer On
Set Device to Print
Endif
Endif
set color to
clear
no =0
brs =0
Grand =0
do Judul5
Select 1
select 4
set relation to kdbr into Barang
go top
do while .not. eof()
if xNofak=Nofak
no=no+1
@brs,00 say no Pict'99'
@brs,04 say Kdbr
@brs,10 say (barang->nabar)
@brs,30 say (barang->hjual) pict'Rp 999,999,999'
@brs,45 say Jjual pict'999'
@brs,57 say Tharga pict'Rp 999,999,999'
Grand=Grand+Tharga
brs=brs+1
endif
skip
enddo
?repl(chr(205),79)
setcolor('g+/n+')
?'Total Harga Penjualan : '+Trans(Grand,'Rp 99,999,999,999')
@24,0 say 'Tekan Sembarang Tombol...........!!!!!'color('br*+/n+')
inkey(0)
Rest screen From Layarx
Lagi=space(1)
do Sbox with 18,15,20,65,"w/b,gr+/bg"
Do while .not. Lagi $'YT'
@19,16 say 'Input Data Lagi : 'get Lagi pict'!'
read
Enddo
If Lagi='Y'
rest screen from layarx
Loop
Else
rest screen from layarx
Exit
Endif
Enddo
rest screen from layarx
setcolor()
return
Proc Judul5
setcolor('bg+/n+')
@00,0 say 'Daftar data-data Penjualan Barang'
@01,0 say 'Untuk No.Faktur :'+xNofak
@02,0 say 'Tanggal Penjualan :'+Dtoc(TgJual)
setcolor('w+/n+')
@03,0 say repl(chr(205),79)
@04,0 say 'No Kode Nama Harga Jumlah Total'
@05,0 say ' Barang Barang Jual Jual Harga'
@06,0 say repl(chr(196),79)
brs=7
