* =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
* Program Untuk mencetak Kwitansi
* (c) Armansyah 1997
* =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Set Wrap On
Set Talk Off
Set Status Off
Set ScoreBoard Off
Set Century On
Set Deleted On
Set Message To 24 Center
Save Screen To Armansyahskom
Public xOleh, xUsaha, xAlamat1, xAlamat2, xAlamat3
If ! File("kwitansi.ini")
Do Konfig
EndIf
Clea
Set Color To Bg++
For x= 1 To 23
@x, 0 Say Repl("Û", 80)
Next
Set Color To Gr+/B
BlowUp(0,0,02,78)
@0, 0 Clear To 2, 78
@0, 0 To 2, 78
Shadow(0,0,02,78)
xUsaha = Alltrim(xUsaha)
@1, 40 - Len(xUsaha) / 2 Say xUsaha
Do Panggil
Do Blangko With 4, 5, 70
SetColor("B/W, W/B,,, R/W")
BlowUp(20,0,23,78)
@20, 0 Clear To 23, 78
@20, 0 To 23, 78
Shadow(20,0,23,78)
Do While .T.
@24, 00
Set Key 5 To Up
Set Key 24 To Under
@ 21, 05 Prompt " Tambah " ;
Message "Menambah data baru"
@ 21, Col() Prompt " Ralat " ;
Message "Meralat data yang dituju"
@ 21, Col() Prompt " Hapus " ;
Message "Menghapus data yang dipilih"
@ 21, Col() Prompt " Mundur " ;
Message "Mundur satu Record"
@ 21, Col() Prompt " Maju " ;
Message "Maju satu Record"
@ 21, Col() Prompt " Awal " ;
Message "Menuju Record paling awal"
@ 21, Col() Prompt " Akhir " ;
Message "Menuju Record paling akhir"
@ 22, 05 Prompt " Tujuan " ;
Message "Mencari Record tertentu"
@ 22, Col() Prompt " Tabel " ;
Message "Menampilkan Data dalam bentuk Tabel"
@ 22, Col() Prompt " Jumlah " ;
Message "Menghitung Jumlah Seluruh Record DataBase"
@ 22, Col() Prompt " Indeks " ;
Message "Mengindeks DataBase kembali"
@ 22, Col() Prompt " Cetak " ;
Message "Mencetak Kwitansi keatas Kertas"
@ 22, Col() Prompt " Konfig " ;
Message "Konfigurasi Program"
@ 22, Col() Prompt " Keluar " ;
Message "Keluar dari Menu Kwitansi"
Menu To Pilih
Set Key 5 To
Set Key 24 To
Do Case
Case Pilih= 1
Do Isi With "Entry"
Case Pilih= 2
If RecCount() # 0
Do Isi With "Edit"
Else
Nitip("Data masih kosong !")
EndIf
Case Pilih= 3
If RecCount() # 0
Do Show_it With "Hapus"
Else
Nitip("Data masih kosong !")
EndIf
Case Pilih= 4
If RecCount()= 0
Nitip("Data masih kosong !")
Loop
EndIf
If ! Bof()
Skip -1
Do Show_it With "Tampil"
Else
Nitip("Awal Record !")
EndIf
Case Pilih= 5
If RecCount()= 0
Nitip("Data masih kosong !")
Loop
EndIf
If ! Eof()
Skip 1
Do Show_it With "Tampil"
Else
Nitip("Akhir Record !")
EndIf
Case Pilih= 6
If RecCount() # 0
Go Top
Do Show_it With "Tampil"
Else
Nitip("Data masih kosong !")
EndIf
Case Pilih= 7
If RecCount() # 0
Go Bottom
Do Show_it With "Tampil"
Else
Nitip("Data masih kosong !")
EndIf
Case Pilih= 8
If RecCount() # 0
Rek= Tanya()
GoTo(Rek)
Do Show_it With "Tampil"
Else
Nitip("Data masih kosong !")
EndIf
Case Pilih= 9
If RecCount() # 0
Do Tabel
Else
Nitip("Data masih kosong !")
EndIf
Case Pilih= 10
If RecCount() # 0
Do Jumlah
Else
Nitip("Data masih kosong !")
EndIf
Case Pilih= 11
If RecCount() # 0
Do Indeks
Else
Nitip("Data masih kosong !")
EndIf
Case Pilih= 12
Lanjut= 0
If RecCount()= 0
Nitip("Data masih kosong !")
EndIf
Do While ! IsPrinter()
Lanjut= PopMenu(0, 0, "Printer belum siap !", ;
" Batal ", " Lanjut ")
If Lanjut= 0
Exit
ElseIf Lanjut= 1
Exit
EndIf
Enddo
If Lanjut # 1
Do Cetak
EndIf
Case Pilih= 13
Do Konfig
Case Pilih= 14 .or. Pilih = 0
Exit
Restore Screen From Armansyahskom
EndCase
EndDo
* =-=-=
* Under
* =-=-=
Procedure Under
SetColor("B/W, B/W,,, B/W")
KeyBoard Chr(4) + Chr(4) + Chr(4) + Chr(4) + Chr(4) + Chr(4) + Chr(4)
SetColor("B/W, W/B,,, B/W")
Return
* =-=-
* Up
* =-=-
Procedure Up
SetColor("B/W, B/W,,, B/W")
KeyBoard Chr(19) + Chr(19) + Chr(19) + Chr(19) + Chr(19) + Chr(19) + Chr(19)
SetColor("B/W, W/B,,, B/W")
Return
* =-=-=-=-=-=
* Konfigurasi
* =-=-=-=-=-=
Procedure Konfig
Private Ya, Klm, Warna, Layar, Usaha, Alamat1, Alamat2, Alamat3
If ! File("kwitansi.ini")
xUsaha= Space(30)
xAlamat1= Space(34)
xAlamat2= Space(34)
xAlamat3= Space(34)
EndIf
Warna= SetColor()
Set Color To Gr+/B
@1, 40 - Len(xUsaha) / 2 Say Space(Len(xUsaha))
Save Screen To Layar
SetColor("Gr/B+, B+/Gr,,, Gr/B+")
BlowUp(03,05,12,75)
@ 3, 5 Clear To 12, 75
@ 3, 5 To 12, 75
Shadow(03,05,12,75)
@ 5, 8 Say "Nama Perusahaan : "
@ 6, 8 Say "Alamat Perusahaan : "
Klm= Col()
@ 10, 8 Say "Anda Yakin Data Benar ? ( Y/T ) : "
Do While .T.
Ya= " "
xUsaha= xUsaha + Space(30 - Len(xUsaha))
SetColor("Gr+/B, N/Bg,,, Gr+/B")
@ 5, Klm Get xUsaha
@ 6, Klm Get xAlamat1
@ 7, Klm Get xAlamat2
@ 8, Klm Get xAlamat3
@ 10, Klm + 13 Get Ya
Set Cursor On
Read
Ya= Alltrim(Upper(Ya))
Set Cursor Off
If Ya= "" .Or. Ya= "Y"
Exit
EndIf
EndDo
Save All Like x* To kwitansi.ini
Restore From kwitansi.ini Additive
Restore Screen From Layar
xUsaha = Alltrim(xUsaha)
@1, 40 - Len(xUsaha) / 2 Say xUsaha
SetColor(Warna)
Return
* =-=-=
* Cetak
* =-=-=
Procedure Cetak
Private Rek, Warna, Layar, Nitip
Private x, Ptg, JlmBrs, Bl, Judul, Usaha, Alamat, Telepon, Bilangan
Warna= SetColor()
Save Screen To Layar
Judul= " Tanda Bukti Pembayaran "
Nitip= "Siapkan kertas, lalu tekan sembarang tombol. . ."
Set Color To Gr+/R
BlowUp(05,05,09,75)
@ 5, 5 Clear To 9, 75
@ 5, 5 To 9, 75
Shadow(05,05,09,75)
@ 7, 40 - Len(Nitip) / 2 Say Nitip
InKey(0)
If Kwitansi->Ubah= .T.
Nitip("Maaf tidak dicetak ganda !")
SetColor(Warna)
Restore Screen From Layar
Return
EndIf
Replace Kwitansi->Ubah with .T.
SetColor(Warna)
Restore Screen From Layar
xUsaha = Alltrim(xUsaha)
xAlamat1 = Alltrim(xAlamat1)
xAlamat2 = Alltrim(xAlamat2)
xAlamat3 = Alltrim(xAlamat3)
Declare Huruf[10]
Huruf[01]= Chr(27)+Chr(15) && Kecil
Huruf[02]= Chr(18) && Normal Kecil
Huruf[03]= Chr(27)+Chr(14) && Besar
Huruf[04]= Chr(20) && NBesar
Huruf[05]= Chr(27)+Chr(69) && Tebal
Huruf[06]= Chr(27)+Chr(70) && Normal Tebal
Huruf[07]= Chr(27)+Chr(52) && Miring
Huruf[08]= Chr(27)+Chr(53) && Normal Miring
Huruf[09]= Chr(27)+Chr(45)+Chr(1) && Garis Bawah
Huruf[10]= Chr(27)+Chr(45)+Chr(0) && Normal Garis Bawah
Set Device To Print
@ 01, 46 Say Huruf[1] + Huruf[5] + xUsaha
@ 02, 46 Say xAlamat1
@ 03, 46 Say xAlamat2
@ 04, 46 Say xAlamat3 + Huruf[7] + Huruf[2]
@ 05, 05 Say "Jam Cetak : "
@ 05, PCol() Say Time()
@ 06, 05 Say "Tgl Cetak : "
@ 06, PCol() Say Date()
@ 09, 26 Say Huruf[8] + Huruf[5] + Huruf[9] + Judul + ;
Huruf[10]
@ 12, 05 Say "Nomor Kwitansi : " + Nomor
@ 13, 05 Say "Sudah diterima dari : " + Dari
@ 14, 05 Say "Pada tanggal : " + TGL
@ 15, 05 Say "Sejumlah Rp. " + TransForm(Rupiah, ;
"999,999,999,999,-")
@ 16, 05 Say "Untuk pembayaran : " + Untuk
@ 17, 05 Say "Terbilang Banyaknya : " + Huruf[7]
Bilangan= Alltrim(Terbilang(Int(Rupiah / 1))) + ' Rupiah.'
JmlBrs= MlCount(Bilangan, 50)
For x= 1 To JmlBrs
Ptg= MemoLine(Bilangan, 50, x)
Ptg= If(Right(Ptg, 1)= " ", Ptg, Ptg + "-")
@ 16 + x, 30 Say Huruf[9] + Alltrim(Ptg) + Huruf[10]
Next
@ 22, 50 Say Huruf[8] + "Hormat Kami,"
@ 28, 45 Say "(" + Huruf[9] + Repl(" ", 20) + Huruf[10] + ")" + ;
Huruf[5]
Eject
Set Device To Screen
Return
* =-=-=
* Tabel
* =-=-=
Procedure Tabel
Private Warna, Layar
Declare Nam[6], Pik[6], Kep[6]
Tone(750, 1)
Tone(500, 1)
Warna= SetColor()
Save Screen To Layar
Nam[1]= "NOMOR"
Pik[1]= "@!"
Kep[1]= "Nomor"
Nam[2]= "TGL"
Pik[2]= "@!"
Kep[2]= "Tanggal"
Nam[3]= "DARI"
Pik[3]= "@!"
Kep[3]= "Diterima dari"
Nam[4]= "RUPIAH"
Pik[4]= "Rp 999,999,999,999,-"
Kep[4]= "Sebanyak"
Nam[5]= "UNTUK"
Pik[5]= "@!"
Kep[5]= "Untuk Pembayaran"
SetColor("N/Bg, Gr+/B,,, N/Bg")
BlowUp(04,02,19,78)
@ 4, 2 Clear To 19, 78
@ 4, 2 To 19, 78 Double
Shadow(04,02,19,78)
DbEdit(5, 3, 18, 77, Nam, "", Pik, Kep)
SetColor(Warna)
Restore Screen From Layar
Return
* =-=-=-
* Jumlah
* =-=-=-
Procedure Jumlah
Private Warna, Layar, Rek
Tone(750, 1)
Tone(500, 1)
Rek= LastRec()
Rek= Str(Rek, 3)
Warna= SetColor()
Save Screen To Layar
Set Color To Gr+/Bg
Nitip= "Jumlah Record yang ada : " + Rek
BlowUp(05,05,09,75)
@ 5, 5 Clear To 9, 75
@ 5, 5 To 9, 75
Shadow(05,05,09,75)
@ 7, 40 - Len(Nitip) / 2 Say Nitip
InKey(1.5)
SetColor(Warna)
Restore Screen From Layar
Return
* =-=
* Pop
* =-=
Function Pop
Parameters Brs, Klm, Nitip, Par1, Par2
Private Warna, Layar, Pilih
Tone(750, 1)
Tone(500, 1)
Warna= SetColor()
Save Screen To Layar
SetColor("N/W, W/N,,, N/W")
@ Brs, Klm Clear To Brs + 5, Klm + 40
@ Brs, Klm To Brs + 5, Klm + 40
@ Brs + 1, Klm + 2 Say Nitip
Nitip= Repl("Ä", 38)
@ Brs + 2, Klm + 1 Say Nitip
Do While .T.
@24, 00
@ Brs + 3, Klm + 2 Prompt " " + Par1 + " "
@ Brs + 4, Klm + 2 Prompt " " + Par2 + " "
Menu To Pilih
If LastKey()= 13 .Or. LastKey()= 27
Exit
EndIf
EndDo
SetColor(Warna)
Restore Screen From Layar
Return(Pilih)
Restore Screen From Ferawati
* =-=-=
* Nitip
* =-=-=
Function Nitip
Parameters Nitip
Private Warna, Layar
Set Cursor Off
Tone(750, 1)
Tone(500, 1)
Warna= SetColor()
Save Screen To Layar
Set Color To Gr+/R
BlowUp(05,05,09,75)
@ 5, 5 Clear To 9, 75
@ 5, 5 To 9, 75
@ 7, 40 - Len(Nitip) / 2 Say Nitip
Shadow(05,05,09,75)
InKey(1.5)
SetColor(Warna)
Restore Screen From Layar
Set Cursor On
Return .T.
* =-=-=-
* Indeks
* =-=-=-
Procedure Indeks
Private Warna, Layar, Nitip
Tone(750, 1)
Tone(500, 1)
Warna= SetColor()
Save Screen To Layar
Set Color To Gr+/Bg
Nitip= "Tunggu proses Reindex sedang berlangsung. . ."
BlowUp(05,05,09,75)
@ 5, 5 Clear To 9, 75
@ 5, 5 To 9, 75
Shadow(05,05,09,75)
@ 7, 40 - Len(Nitip) / 2 Say Nitip
Erase Kwitansi.Ids
Index On Nomor To Kwitansi.Ids
InKey(1.5)
SetColor(Warna)
Restore Screen From Layar
Return
* =-=-=
* Tanya
* =-=-=
Function Tanya
Private x, Ada, Temu, Ketik, Warna, Layar, NoRek
Warna= SetColor()
Save Screen To Layar
NoRek= RecNo()
Do While .T.
Ketik= Space(25)
Set Color To Gr+/Bg
BlowUp(05,12,09,68)
@ 5, 12 Clear To 9, 68
@ 5, 12 To 9, 68
Shadow(05,12,09,68)
SetColor("Gr+/Bg, N/W,,, Gr+/Bg")
@ 7, 18 Say "Yang dicari : " Get Ketik Pict "@!"
Set Cursor On
Read
Set Cursor Off
Ketik= Alltrim(Ketik)
If LastKey()= 27
GoTo(NoRek)
Exit
EndIf
Ada= .F.
Temu= 0
Set Exact Off
For x= 1 To RecCount()
GoTo(x)
Temu= At(Ketik, NOMOR)
If Temu # 0
Ada= .T.
Exit
EndIf
Temu= At(Ketik, DARI)
If Temu # 0
Ada= .T.
Exit
EndIf
Temu= At(Ketik, TGL)
If Temu # 0
Ada= .T.
Exit
EndIf
Temu= At(Ketik, UNTUK)
If Temu # 0
Ada= .T.
Exit
EndIf
Next
If Ada
Exit
Else
Nitip("Maaf, tidak ditemukan !")
Loop
EndIf
EndDo
Set Exact On
NoRek= RecNo()
SetColor(Warna)
Restore Screen From Layar
Return(NoRek)
* =-=-=-=-
* Isi Data
* =-=-=-=-
Procedure Isi
Parameter Perlu1
Private x, No, Sw, Byk, Brs, Klm, Ptg, Warna, JmlBrs, Bilangan
Sw= 1
Brs= 7
Klm= 30
Byk= FCount()
Warna= SetColor()
Declare MVar[Byk + 1], MTip[Byk], MLeb[Byk]
AFields("", MTip, MLeb)
Do While .T.
If Sw= 1
For x= 1 To Byk
If MTip[x]= "C"
MVar[x]= Space(MLeb[x])
Else
MVar[x]= 0
EndIf
Next
EndIf
No= If(RecCount()= 0 .Or. Perlu1= "Edit", RecNo(), RecNo() + 1)
MVar[1]= StrZero(No, MLeb[1])
MVar[3]= DToC(Date())
SetColor("Gr+/B, N/Bg,,, Gr+/B")
@Brs - 2, Klm + 20 Say No Pict "@E 99999"
@Brs + 1, Klm Get MVar[1] Pict "@!" Valid ! Empty(MVar[1])
Set Cursor On
Read
Set Cursor Off
If LastKey()= 27
Exit
EndIf
Seek MVar[1]
If Perlu1= "Entry"
If Found()
Nitip("Nomor tersebut sudah ada !")
Loop
EndIf
ElseIf Perlu1= "Edit"
If ! Found()
Nitip("Nomor tersebut tidak ada !")
Loop
EndIf
Do Show_it With "Tampil"
EndIf
@Brs + 2, Klm Get MVar[2] Pict "@!" Valid ! Empty(MVar[2])
@Brs + 3, Klm Get MVar[3] Pict "99/99/9999" Valid ! Empty(MVar[3])
@Brs + 4, Klm Get MVar[4] Pict "999,999,999,999,-" Valid ! Empty(MVar[4])
Set Cursor On
Read
Set Cursor Off
Set Color To B/Bg
@Brs + 8, 0 Clear To Brs + 12, 79
@Brs + 8, 0 To Brs + 12, 79
@Brs + 9, 5 Say "Terbilang : "
Set Color To Gr+/Bg
Bilangan= Alltrim(Terbilang(Int(MVar[4] / 1))) + ' Rupiah.'
JmlBrs= MlCount(Bilangan, 65)
For x= 1 To JmlBrs
Ptg= MemoLine(Bilangan, 65, x)
@x + (Brs + 9), 5 Say Alltrim(Ptg)
Next
Set Color To Gr+/B
@Brs + 5, Klm Get MVar[5] Pict "@!" Valid ! Empty(MVar[5])
Set Cursor On
Read
Set Cursor Off
If Perlu1= "Entry"
Benar= PopMenu(0, 0, "Data mau direkam (Y/T) ? ", "Ya ", "Tidak")
ElseIf Perlu1= "Edit"
Benar= Popmenu(0, 0, "Data mau diubah (Y/T) ? ", "Ya ", "Tidak")
EndIf
If Benar= 0
Exit
ElseIf Benar= 1
Sw= 1
ElseIf Benar= 2
Sw= 0
Loop
EndIf
If Perlu1= "Entry"
Append Blank
Do Rekam
No= No + 1
ElseIf Perlu1= "Edit"
If Kwitansi->Ubah= .T.
EndIf
Do Rekam
EndIf
Do Blangko With 4, 5, 70
EndDo
SetColor(Warna)
Return
* =-=-=-=-=
* Show_it
* =-=-=-=-=
Procedure Show_it
Parameters Perlu2
Private Brs, Klm, Warna
Brs= 7
Klm= 30
If RecNo() > LastRec()
Return
EndIf
Warna= SetColor()
Do While .T.
MKode= Space(Len(Nomor))
SetColor("Gr+/B, N/Bg,,, Gr+/B")
@Brs - 2, Klm + 20 Say RecNo() Pict "@E 99999"
Read
If Perlu2= "Hapus"
@Brs + 1, Klm Get MKode Pict "@!" Valid ! Empty(MKode)
Set Cursor On
Read
Set Cursor Off
If LastKey()= 27
Exit
EndIf
Seek MKode
If ! Found()
Nitip("Nomor tersebut tidak ditemukan !")
Loop
EndIf
EndIf
@Brs - 2, Klm + 20 Say RecNo() Pict "@E 99999"
@Brs + 1, Klm Say Nomor
@Brs + 2, Klm Say Dari
@Brs + 3, Klm Say TGL
@Brs + 4, Klm Say TransForm(Rupiah, "999,999,999,999,-")
@Brs + 5, Klm Say Untuk
Read
Set Color To B/Bg
@Brs + 8, 0 Clear To Brs + 12, 79
@Brs + 8, 0 To Brs + 12, 79
@Brs + 9, 5 Say "Terbilang : "
Set Color To Gr+/Bg
Bilangan= Alltrim(Terbilang(Int(Rupiah / 1))) + ' Rupiah.'
JmlBrs= MlCount(Bilangan, 65)
For x= 1 To JmlBrs
Ptg= MemoLine(Bilangan, 65, x)
@x + (Brs + 9), 5 Say Alltrim(Ptg)
Next
If Perlu2= "Hapus"
Benar= PopMenu(0, 0, "Data mau dihapus (Y/T) ? ", "Ya ", "Tidak")
*Benar= Pop(0, 0, "Data mau dihapus (Y/T) ? ", "Ya ", "Tidak")
If Benar= 0
Exit
ElseIf Benar= 1
If Kwitansi->Ubah= .T.
EndIf
Delete
Pack
ElseIf Benar= 2
Loop
EndIf
ElseIf Perlu2= "Tampil"
Exit
EndIf
EndDo
SetColor(Warna)
Return
* =-=-=-=-=-
* Rekam data
* =-=-=-=-=-
Procedure Rekam
Replace ;
Kwitansi->NOMOR With MVar[1], ;
Kwitansi->DARI With MVar[2], ;
Kwitansi->TGL With MVar[3], ;
Kwitansi->RUPIAH With MVar[4], ;
Kwitansi->UNTUK With MVar[5], ;
Kwitansi->UBAH With .F.
Return
* =-=-=-=-=-=-=
* Buat DataBase
* =-=-=-=-=-=-=
Procedure Panggil
Private x, Warna, Layar, Nitip
Warna= SetColor()
Save Screen To Layar
If ! File("Kwitansi.fxh")
Tone(750, 1)
Tone(500, 1)
Declare Nam[6], Tip[6], Leb[6]
Set Color To Gr+/B
Nitip= "Proses pembentukkan DataBase sedang berlangsung. . ."
BlowUp(05,05,09,75)
@ 5, 5 Clear To 9, 75
@ 5, 5 To 9, 75
Shadow(05,05,09,75)
@ 7, 40 - Len(Nitip) / 2 Say Nitip
Nam[1]= "NOMOR"
Tip[1]= "C"
Leb[1]= 5
Nam[2]= "DARI"
Tip[2]= "C"
Leb[2]= 30
Nam[3]= "TGL"
Tip[3]= "C"
Leb[3]= 10
Nam[4]= "RUPIAH"
Tip[4]= "N"
Leb[4]= 12
Nam[5]= "UNTUK"
Tip[5]= "C"
Leb[5]= 30
Nam[6]= "UBAH"
Tip[6]= "L"
Leb[6]= 1
Creat Temp
For x= 1 To Len(Nam)
Append Blank
Replace ;
Field_Name With Nam[x], ;
Field_Type With Tip[x], ;
Field_Len With Leb[x], ;
Field_Dec With 0
Next
Use
Creat Kwitansi.fxh From Temp
Erase Temp
Close DataBase
SetColor(Warna)
Restore Screen From Layar
EndIf
Use Kwitansi.fxh
If ! File("Kwitansi.Ids")
Tone(750, 1)
Tone(500, 1)
Set Color To Gr+/B
Nitip= "Proses pembentukkan File Index sedang berlangsung. . ."
BlowUp(05,05,09,75)
@ 5, 5 Clear To 9, 75
@ 5, 5 To 9, 75
Shadow(05,05,09,75)
@ 7, 40 - Len(Nitip) / 2 Say Nitip
Index On Nomor To Kwitansi.Ids
InKey(1.5)
SetColor(Warna)
Restore Screen From Layar
EndIf
Set Index To Kwitansi.Ids
Go Bottom
Return
Saturday, July 19, 2008
Program Kwitansi
