Berikut ini Code untuk Form Input, yg terbagi menjadi 2 bagian.

1. Form Input Karyawan
2. Form Input Tenaga Ahli

frmInputKaryawan.frm

Option Explicit
Private Sub cboStatus_Click()
cboPtkp.Text = cboPtkp.List(cboStatus.ListIndex)
txtGP.SetFocus
SendKeys “{Home}+{End}”
End Sub

Private Sub cmdClear_Click()
ProsesBersih
End Sub

Private Sub cmdExit_Click()
If MsgBox(”Yakin akan keluar?”, vbQuestion + vbOKCancel, “Konfirmasi…”) = vbOK Then Unload Me
End Sub

Private Sub cmdHapus_Click()
Dim strNPWP As String

strNPWP = MaskEdBox1.Text
If MsgBox(”Yakin Hapus data NPWP: ” & strNPWP, vbQuestion + vbYesNo, “Konfirmasi…”) = vbYes Then
SQL = “DELETE FROM karyawan WHERE npwp=’” & strNPWP & “‘”
ConnMDB.Execute SQL
MsgBox “Data sudah diHapus!”, vbInformation, “Status…”
ProsesBersih
cmdHapus.Enabled = False
cmdSimpan.Enabled = False
MaskEdBox1.SetFocus
End If
End Sub

Private Sub cmdSimpan_Click()
If cmdSimpan.Caption = “&Simpan” Then
ProsesSimpan
Else
ProsesEdit
End If
End Sub

Private Sub Form_Load()

Dim lheight, lwidth, loffset, toffset As Integer
‘Atur posisi form
‘Agar ditengah layar
If Me.MDIChild = True Then
lheight = MDIfrmUtama.ScaleHeight
lwidth = MDIfrmUtama.ScaleWidth
Else
lheight = Screen.Height
lwidth = Screen.Width
End If

loffset = ((lwidth - Me.Width) / 2)
toffset = ((lheight - Me.Height) / 2)
Me.Move loffset, toffset

‘Isi Combo Status
With cboStatus
.AddItem “WP”
.AddItem “WP Kawin”
.AddItem “Isteri Bekerja”
.AddItem “Kawin / 1″
.AddItem “Kawin / 2″
.AddItem “Kawin / 3″
.Text = .List(0)
End With

‘Isi Combo PTKP
With cboPtkp
.AddItem “1,320,000″
.AddItem “1,430,000″
.AddItem “2,640,000″
.AddItem “1,540,000″
.AddItem “1,650,000″
.AddItem “1,760,000″
.Text = .List(0)
End With
End Sub
Function CekValidInput() As String
‘Cek Validasi Inputan
Dim obj As Object
CekValidInput = “”
For Each obj In Me
If TypeName(obj) = “TextBox” Then
Dim strObj As String
strObj = obj.Name
Dim namaTextBox As String
namaTextBox = UCase(Mid(obj.Name, 4, Len(strObj) - 3))
If obj.Text = “” Then: CekValidInput = namaTextBox: Exit For
End If
Next
End Function
Sub ProsesSimpan()
If CekValidInput <> “” Then
MsgBox CekValidInput & ” belum diisi!”
Exit Sub
End If

HitungPPh
‘Masuk Database
SQL = “INSERT INTO karyawan (NPWP, [Nama WP], Alamat, Status, [Gaji Pokok], Tunjangan, Lembur, [Jumlah Penghasilan Tetap], ” & _
“[Biaya Jabatan], [Jumlah Penghasilan Netto], [Penghasilan Tidak Tetap], [Total Penghasilan], PTKP, PKP, [PPh Pasal 21]) ” & _
“VALUES (’” & MaskEdBox1.Text & “‘,’” & _
txtNama.Text & “‘,’” & _
txtAlamat.Text & “‘,’” & _
cboStatus.Text & “‘,” & _
CCur(txtGP.Text) & “,” & _
CCur(txtTunj.Text) & “,” & _
CCur(txtLembur.Text) & “,” & _
CCur(txtTetap.Text) & “,” & _
CCur(txtJabatan.Text) & “,” & _
CCur(txtNetto.Text) & “,” & _
CCur(txtTdkTetap.Text) & “,” & _
CCur(txtTotal.Text) & “,” & _
CCur(cboPtkp.Text) & “,” & _
CCur(txtPkp.Text) & “,” & _
CCur(txtPPh.Text) & “)”

ConnMDB.Execute SQL

MsgBox “Data sudah terSimpan!”, vbInformation, “Status…”
cmdSimpan.Enabled = False
MaskEdBox1.SetFocus
ProsesBersih
End Sub

Sub ProsesEdit()
If CekValidInput <> “” Then
MsgBox CekValidInput & ” belum diisi!”
Exit Sub
End If

HitungPPh
SQL = “UPDATE karyawan SET ” & _
“[Nama WP]=’” & txtNama.Text & “‘” & _
“, Alamat=’” & txtAlamat.Text & “‘” & _
“, Status=’” & cboStatus.Text & “‘” & _
“, [Gaji Pokok]=” & CCur(txtGP.Text) & _
“, Tunjangan=” & CCur(txtTunj.Text) & _
“, Lembur=” & CCur(txtLembur.Text) & _
“, [Jumlah Penghasilan Tetap]=” & CCur(txtTetap.Text) & _
“, [Biaya Jabatan]=” & CCur(txtJabatan.Text) & _
“, [Jumlah Penghasilan Netto]=” & CCur(txtNetto.Text) & _
“, [Penghasilan Tidak Tetap]=” & CCur(txtTdkTetap.Text) & _
“, [Total Penghasilan]=” & CCur(txtTotal.Text) & _
“, PTKP=” & CCur(cboPtkp.Text) & _
“, PKP=” & CCur(txtPkp.Text) & _
“, [PPh Pasal 21]=” & CCur(txtPPh.Text) & _
” WHERE npwp=’” & MaskEdBox1.Text & “‘”

ConnMDB.Execute SQL

MsgBox “Data telah diEdit..”, vbInformation, “Status…”
ProsesBersih
MaskEdBox1.SetFocus
End Sub

Private Sub MaskEdBox1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Dim Rs As New ADODB.Recordset
Dim strNPWP As String

strNPWP = MaskEdBox1.Text
SQL = “SELECT * FROM karyawan WHERE npwp=’” & strNPWP & “‘”
Rs.Open SQL, ConnMDB, adOpenStatic, adLockPessimistic

If Not Rs.EOF Then
txtNama.Text = Rs(”Nama WP”).Value
txtAlamat.Text = Rs(”Alamat”).Value
cboStatus.Text = Rs(”Status”).Value
txtGP.Text = FormatNumber(CCur(Rs(”Gaji Pokok”).Value), 0)
txtTunj.Text = FormatNumber(CCur(Rs(”Tunjangan”).Value), 0)
txtLembur.Text = FormatNumber(CCur(Rs(”Lembur”).Value), 0)
txtTetap.Text = FormatNumber(CCur(Rs(”Jumlah Penghasilan Tetap”).Value), 0)
txtJabatan.Text = FormatNumber(CCur(Rs(”Biaya Jabatan”).Value), 0)
txtNetto.Text = FormatNumber(CCur(Rs(”Jumlah Penghasilan Netto”).Value), 0)
txtTdkTetap.Text = FormatNumber(CCur(Rs(”Penghasilan Tidak Tetap”).Value), 0)
txtTotal.Text = FormatNumber(CCur(Rs(”Total Penghasilan”).Value), 0)
cboPtkp.Text = FormatNumber(CCur(Rs(”PTKP”).Value), 0)
txtPkp.Text = FormatNumber(CCur(Rs(”PKP”).Value), 0)
txtPPh.Text = FormatNumber(CCur(Rs(”PPh Pasal 21″).Value), 0)
cmdSimpan.Enabled = True
cmdSimpan.Caption = “&Edit”
cmdHapus.Enabled = True
Else
ProsesBersih
cmdSimpan.Caption = “&Simpan”
cmdSimpan.Enabled = False
cmdHapus.Enabled = False

End If

Rs.Close
Set Rs = Nothing

BukaSemua_TextBox
txtNama.SetFocus
SendKeys “{Home}+{End}”
End If
End Sub

Private Sub txtAlamat_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii))) ‘ Buat Huruf GEDE
If KeyAscii = 13 Then cboStatus.SetFocus
End Sub

Private Sub txtGP_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc(”0″) And KeyAscii <= Asc(”9″) Or KeyAscii = 13 Or KeyAscii = 8 Or KeyAscii = vbKeyBack) Then KeyAscii = 0
If KeyAscii = 13 Then
txtTunj.SetFocus
HitungPPh
SendKeys “{Home}+{End}”
End If
End Sub

Sub BukaSemua_TextBox()
Dim obj As Object
For Each obj In Me
If TypeName(obj) = “TextBox” Then
obj.Locked = False
Dim strObj As String
strObj = obj.Name
If strObj = “txtTetap” Then obj.Locked = True
If strObj = “txtJabatan” Then obj.Locked = True
If strObj = “txtNetto” Then obj.Locked = True
If strObj = “txtTotal” Then obj.Locked = True
If strObj = “txtPkp” Then obj.Locked = True
If strObj = “txtPph” Then obj.Locked = True
End If
Next
End Sub

Private Sub txtLembur_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc(”0″) And KeyAscii <= Asc(”9″) Or KeyAscii = 13 Or KeyAscii = 8 Or KeyAscii = vbKeyBack) Then KeyAscii = 0
If KeyAscii = 13 Then
txtTdkTetap.SetFocus
HitungPPh
SendKeys “{Home}+{End}”
End If
End Sub

Private Sub txtNama_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii))) ‘ Buat Huruf GEDE
If KeyAscii = 13 Then txtAlamat.SetFocus: SendKeys “{Home}+{End}”
End Sub

Private Sub txtTdkTetap_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc(”0″) And KeyAscii <= Asc(”9″) Or KeyAscii = 13 Or KeyAscii = 8 Or KeyAscii = vbKeyBack) Then KeyAscii = 0
If KeyAscii = 13 Then
cmdSimpan.Enabled = True
cmdSimpan.SetFocus
HitungPPh
End If
End Sub

Private Sub txtTunj_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc(”0″) And KeyAscii <= Asc(”9″) Or KeyAscii = 13 Or KeyAscii = 8 Or KeyAscii = vbKeyBack) Then KeyAscii = 0
If KeyAscii = 13 Then
txtLembur.SetFocus
HitungPPh
SendKeys “{Home}+{End}”
End If
End Sub

Sub HitungPPh()
On Error GoTo ErrorHitung
Dim obj As Object
txtNama.Text = Replace(txtNama.Text, “‘”, “”)
txtAlamat.Text = Replace(txtAlamat.Text, “‘”, “”)

For Each obj In Me
If TypeName(obj) = “TextBox” Then
If obj.Text = “” Then obj.Text = 0
End If
Next

txtGP.Text = FormatNumber(CCur(txtGP.Text), 0)
txtTunj.Text = FormatNumber(CCur(txtTunj.Text), 0)
txtLembur.Text = FormatNumber(CCur(txtLembur.Text), 0)
txtTetap.Text = FormatNumber(CCur(txtGP.Text) + CCur(txtTunj.Text) + CCur(txtLembur.Text), 0)
txtTdkTetap.Text = FormatNumber(CCur(txtTdkTetap.Text), 0)

Dim dBiayaJabatan As Double
Dim dPPh As Double
Dim dPkp As Double
Dim dTotal As Double

dBiayaJabatan = CCur(txtTetap.Text * 5 / 100)
txtJabatan.Text = FormatNumber(IIf(dBiayaJabatan > 108000, 108000, dBiayaJabatan), 0)

txtNetto.Text = FormatNumber(CCur(txtTetap.Text) - CCur(txtJabatan.Text), 0)

dTotal = CCur(txtNetto.Text) + CCur(txtTdkTetap.Text)
txtTotal.Text = IIf(dTotal <= 0, 0, FormatNumber(dTotal, 0))

dPkp = CCur(txtTotal.Text) - CCur(cboPtkp.Text)
txtPkp.Text = IIf(dPkp <= 0, 0, FormatNumber(dPkp, 0))

Select Case dPkp
Case Is <= 0: dPPh = 0
Case 1 To 50000000: dPPh = 5 / 100 * dPkp
Case 50000001 To 250000000: dPPh = 15 / 100 * dPkp
Case 250000001 To 500000000: dPPh = 25 / 100 * dPkp
Case Is > 500000000: dPPh = 30 / 100 * dPkp

End Select

txtPPh.Text = FormatNumber(dPPh, 0)
Exit Sub
ErrorHitung:
MsgBox Err.Number & ” ” & Err.Description
End Sub

Sub ProsesBersih()
Dim obj As Object
For Each obj In Me
If TypeName(obj) = “TextBox” Then obj.Text = “”
Next
End Sub

Program yang diCompile menggunakan Clipper biasanya membutuhkan setingan tambahan, antara lain:

1. System Operasi MS-DOS dan Win 9x

• AutoExec.Bat: SET CLIPPER=//F:99
• Config.Sys: FILES=150 | BUFFERS=50

2. System Operasi Win XP

• File AutoExec.Nt di C:\Windows\System32: SET CLIPPER=//F:99
• Config.Nt di C:\Windows\System32: FILES=150 | BUFFERS=50

3. System Operasi Win ME:  yang ini agak ribet, setingannya saya agak lupa, nanti cari-cari catetan dulu deh…

Lagi enak2 senderan bis makan siang, tau2 pundak ditepuk ma Utut anak Tax.

“Gw mo TA nih…, mo ga bikinin Aplikasi PPh Pasal 21?”

“Berapa duit?”

“150 rb!, tp seminggu ya…, trus pake VB6″

“Ok Deal!”

Mendesign Struktur Database

Tentukan dahulu struktur Databasenya, saya tulis dalam vbModul seperti berikut:

mdlUtama.bas

Option Explicit
‘ Koneksi DataBase menggunakan:
‘ - Reference Microsoft ActiveX Data Object 2.x Library
‘ - Reference ADO Ext. 2.x For DDL and Security

Public ConnMDB As New ADODB.Connection
Public CatMDB As New ADOX.Catalog
Public CatRpt As New ADOX.Catalog
Public TblMDB As ADOX.Table
Public TblRpt As ADOX.Table
Public strFile As String
Public SQL As String
Public i As Integer
Public strUser As String
Public strPlu As String

Public Sub Main()

‘ Buka Koneksi DataBase Cukup Sekali saja
‘ Panggil Sub Koneksi Database
Call KoneksiData
MDIfrmUtama.Show

End Sub

Public Sub KoneksiData()

‘Letak Database sama dengan Path Aplikasi
strFile = App.Path & “\Utut.Mdb”

‘Cek keberadaan data
If Dir(strFile) = “” Then

‘Jika tidak ada buat Database baru
CatMDB.Create “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=” & strFile & _
“;Jet OLEDB:Database Password=;”

‘Buat Tabel Karyawan
Set TblMDB = New ADOX.Table
With TblMDB
.Name = “Karyawan”
.Columns.Append “NPWP”, adVarWChar, 50
.Columns.Append “Nama WP”, adVarWChar, 100
.Columns.Append “Alamat”, adVarWChar, 100
.Columns.Append “Status”, adVarWChar, 20
.Columns.Append “Gaji Pokok”, adDouble
.Columns.Append “Tunjangan”, adDouble
.Columns.Append “Lembur”, adDouble
.Columns.Append “Jumlah Penghasilan Tetap”, adDouble
.Columns.Append “Biaya Jabatan”, adDouble
.Columns.Append “Jumlah Penghasilan Netto”, adDouble
.Columns.Append “Penghasilan Tidak Tetap”, adDouble
.Columns.Append “Total Penghasilan”, adDouble
.Columns.Append “PTKP”, adDouble
.Columns.Append “PKP”, adDouble
.Columns.Append “PPh Pasal 21″, adDouble
End With

‘Tambah Primari Key dan Index Key
TblMDB.Keys.Append “PrimeKey”, adKeyPrimary, “NPWP”
TblMDB.Indexes.Append “IndexKey”, “NPWP”
CatMDB.Tables.Append TblMDB
Set TblMDB = Nothing

‘Buat Tabel Tenaga Ahli
Set TblMDB = New ADOX.Table
With TblMDB
.Name = “Tenaga Ahli”
.Columns.Append “NPWP”, adVarWChar, 50
.Columns.Append “Nama WP”, adVarWChar, 100
.Columns.Append “Alamat”, adVarWChar, 100
.Columns.Append “Telepon”, adVarWChar, 30
.Columns.Append “Penghasilan Bruto”, adDouble
.Columns.Append “Keahlian”, adVarWChar, 100
.Columns.Append “PPh Dipotong”, adDouble
End With

‘Tambah Primari Key dan Index Key
TblMDB.Keys.Append “PrimeKey”, adKeyPrimary, “NPWP”
TblMDB.Indexes.Append “IndexKey”, “NPWP”
CatMDB.Tables.Append TblMDB
Set TblMDB = Nothing

ConnMDB.Open “Provider=Microsoft.Jet.OLEDB.4.0;” _
& “Data Source=” & strFile & “;” & _
“Jet OLEDB:Database Password=;”

Else

‘Buka Database yang Exist
ConnMDB.Open “Provider=Microsoft.Jet.OLEDB.4.0;” _
& “Data Source=” & strFile & “;” & _
“Jet OLEDB:Database Password=;”

‘Deklarasi Katalog ke Koneksi yang aktif
CatMDB.ActiveConnection = ConnMDB

End If

End Sub

Selanjutnya tambah MDIForm untuk menu

MDIfrmUtama.frm

Option Explicit

Private Sub MDIForm_Load()

Me.Caption = “Aplikasi PPh Pasal 21″ & ” versi ” & App.Major & “.” & App.Minor

End Sub

Private Sub mnKaryawan_Click()
frmKaryawan.Show
End Sub
Private Sub mnRepKaryawan_Click()
Dim strFileReport As String
Dim strTableReport As String

strFileReport = “C:\Windows\Temp\UtutReport.Mdb”
If Dir(strFileReport) = “” Then

CatRpt.Create “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=” & strFileReport & _
“;Jet OLEDB:Database Password=;”
Else
CatRpt.ActiveConnection = “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=” & strFileReport & _
“;Jet OLEDB:Database Password=;”

End If

For Each TblRpt In CatRpt.Tables
‘jika ada tabel ..
If TblRpt.Name = “Karyawan” Then CatRpt.Tables.Delete TblRpt.Name
Next

strTableReport = Left(strFileReport, Len(strFileReport) - 3) & “Karyawan”
SQL = “SELECT * INTO ” & strTableReport & ” FROM karyawan”
ConnMDB.Execute SQL

With Crt
.ReportFileName = App.Path & “\ReportKaryawan.rpt”
.RetrieveDataFiles
.Action = 1
End With
End Sub

Private Sub mnRepTenagaAhli_Click()
Dim strFileReport As String
Dim strTableReport As String

strFileReport = “C:\Windows\Temp\UtutReport.Mdb”
If Dir(strFileReport) = “” Then

CatRpt.Create “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=” & strFileReport & _
“;Jet OLEDB:Database Password=;”
Else
CatRpt.ActiveConnection = “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=” & strFileReport & _
“;Jet OLEDB:Database Password=;”

End If

For Each TblRpt In CatRpt.Tables
‘jika ada tabel ..
If TblRpt.Name = “Tenaga Ahli” Then CatRpt.Tables.Delete TblRpt.Name
Next

strTableReport = Left(strFileReport, Len(strFileReport) - 3) & “[Tenaga Ahli]”
SQL = “SELECT * INTO ” & strTableReport & ” FROM [Tenaga Ahli]”
ConnMDB.Execute SQL

With Crt
.ReportFileName = App.Path & “\ReportAhli.rpt”
.RetrieveDataFiles
.Action = 1
End With
End Sub

Private Sub mnTenagaAhli_Click()
frmTenagaAhli.Show
End Sub

Design tiap-tiap Laporan dengan Crystal Report 8.5, ambil data dari tabel Karyawan dan Tenaga Ahli.

Form Inputan akan dibahas di bagian 2 nanti.

Untuk sesion ini apa ada pertanyaan?

Tulisan yang ini mungkin dianggap agak basi buat dedengkotnya IT, tapi boleh dites ke anak IT jebolan sekarang, pasti mereka geleng-geleng alias bingung gmana caranya bikin konek 2 PC yang bersistem operasi DOS.

Zaman dulu tuh waktu OS nya masih DOS, kepikiran ga gmana caranya mereka bisa saling komunikasi data, bisa sharing file, bisa chating. Pernah lihat Sistem POS (Point of Sales) tahun 90-an. Antaran Komputer yang satu dengan yang lainnya memakai Database yang sama, program yang dipakai biasanya hasil compile dari FoxPro atau Clipper.

Agak unik memang, tapi apa keuntungannya bila diterapkan dijaman sekarang? pertanyaan yang bagus, akan saya coba jawab:

“Jika anda atau teman anda atau paman anda atau tetangga anda yang mempunyai Warung/Minimarket dengan modal yang terbatas, coba tawarkan untuk membeli komputer seken Pentium I / II paling-paling harganya ga sampai 400 ribu, sudah termasuk CPU+Monitor, syukur-syukur ada yang ngasih, dari pada jadi sarang kecoa digudang, lebih baik diberdayakan. Install DOS 6.22 (recomended), Googling Program POS yang under DOS, mungkin aja ada yang sudah FREE. ”

Bisa dicoba link berikut http://pages.prodigy.net/daleharris/pos3.htm

– udh malem nih, bersambung aja ke Bag. 2 ya… –

Saya dapat Program ini dari temen, katanya bisa melihat PRG (Source Code) untuk Clipper yang sudah menjadi EXE.

Nama Programnya VPP.EXE, setelah dicoba-coba ga berhasil tuh ngeliat Source Code dari EXE. Muncul Error seperti dibawah:

Mungkin temen2 lebih beruntung dari saya, yg mau coba bisa download di sini.

Kalo udah berhasil, info ya ke saya… ditunggu lho…