Setelah kita melihat Contoh Program aplikasi penggajian PT HOYAMA menggunakan visual basic 6.0, selanjutnya kita lihat form penghitungan THR.
Pada kasus ini penghitugan THR pada dasarnya hampir sama dengan penghiungan bonus karyawan yang hanya diberikan satu tahun sekali saja yaitu pada sebelum hari raya idul fitri, pemberian gaji setiap karyawan pun berbeda-beda.


Silahkan anda buat form seperti dibawah ini dengan name=formhitungthr ;
Catatan ;
A. Buat tabel grid
B. Masukkan komponen timer dan crystal rport
C. untuk textbox dengan name tnamab,tgapok, kodeuser pada propertiesnya visible=false


1. Buat sub baru dengan nama sub aktif dan pastekan koding dibawah ini ;
tidcounter.Enabled = True
tidkaryawan.Enabled = True
tnamakaryawan.Enabled = True
tjenisk.Enabled = True
ttglmsk.Enabled = True
tdivisi.Enabled = True
tdepartemen.Enabled = True
tjabatan.Enabled = True
tstatus.Enabled = True
tkodebonus.Enabled = True
cgolongan.Enabled = True
tjklipat.Enabled = True
tthr.Enabled = True
tditerima.Enabled = True
ctambah.Enabled = True
csimpan.Enabled = True
cbatal.Enabled = True

2. Buat sub baru dengan nama sub nonaktif dan pastekan koding dibawah ini ;
tidcounter.Enabled = False
tidkaryawan.Enabled = False
tnamakaryawan.Enabled = False
tjenisk.Enabled = False
ttglmsk.Enabled = False
tdivisi.Enabled = False
tdepartemen.Enabled = False
tjabatan.Enabled = False
tstatus.Enabled = False
tkodebonus.Enabled = False
tgolongan.Enabled = False
tjklipat.Enabled = False
tthr.Enabled = False
tditerima.Enabled = False
ctambah.Enabled = False
csimpan.Enabled = False
cbatal.Enabled = False

3. Buat sub baru dengan nama sub tampil dan pastekan koding dibawah ini ;
 Call koneksi
 rshitungthr.Open "select*from tabelhitungthr", KON
 Set grid1.DataSource = rshitungthr

4. Buat sub baru dengan nama sub kodebonus dan pastekan koding dibawah ini ;
Call koneksi
rsdatabonus.Open "select*from tabelbonus where golongan='" & tgolongan.Text & "' and namabonus='" & tnamab & "'", KON
If rsdatabonus.EOF Then
MsgBox "Maaf Data Bonus Tidak tersedia, Mohon Isi dahulu !", vbInformation
Call bersih
Call Form_Load
Call nonaktif
ctambah.Enabled = True
Else
tkodebonus.Text = rsdatabonus.Fields("kodebonus")
tjklipat.Text = rsdatabonus.Fields("kalilipat")
tthr.Text = Val(tgapok.Text) * Val(tjklipat.Text)
tditerima.Text = tthr.Text
Call nonaktif
csimpan.Enabled = True
cbatal.Enabled = True
End If

5. Buat sub baru dengan nama sub bersih dan pastekan koding dibawah ini ;
tidcounter.Text = ""
tidkaryawan.Text = ""
tnamakaryawan.Text = ""
tjenisk.Text = ""
ttglmsk.Text = ""
tdivisi.Text = ""
tdepartemen.Text = ""
tjabatan.Text = ""
tstatus.Text = ""
tkodebonus.Text = ""
tgolongan.Text = ""
tjklipat.Text = ""
tthr.Text = ""
tditerima.Text = ""

6. pastekan koding dibawah ini ;
Private Sub Form_Load()
Me.Width = 15150
Me.Height = 7365
Call koneksi
tnamab.Text = "THR"
kodeuser.Text = fmenu.StatusBar.Panels(2)
End Sub

7. Double klik pada ctambah dan pastekan koding dibawah ini (declaration=click);
Call koneksi
Call bersih
tidkaryawan.Enabled = True
rshitungthr.Open "select*from tabelhitungthr order by idcountert desc", KON
With rshitungthr
 If .BOF And .EOF Then
  tidcounter.Text = "ST" + Format(Date, "YYMM") + "0001"
  Else
   tidcounter.Text = "ST" + Format(Date, "YYMM") + Right(Str(Val(Right(.Fields("idcountert"), 4)) + 10001), 4)
   End If
   End With
  
tidkaryawan.SetFocus
tidcounter.Enabled = False

 ctambah.Enabled = False
cbatal.Enabled = True
tidcounter.Enabled = False
Call tampil

8. Double klik pada csimpan dan pastekan koding dibawah ini (declaration=click);
Call koneksi
rshitungthr.Open "insert into tabelhitungthr values('" & tidcounter & "','" & tidkaryawan & "','" & tnamakaryawan & "','" & tjenisk & "','" & ttglmsk & "','" & tdivisi & "','" & tdepartemen & "','" & tjabatan & "','" & tstatus & "','" & tkodebonus & "','" & tgolongan & "','" & tjklipat & "','" & tthr & "','" & tditerima & "','" & tgl & "','" & kodeuser & "')", KON
MsgBox "Data Sudah Tersimpan", vbInformation
cr.SelectionFormula = "Totext({tabelhitungthr.idcountert})= '" & tidcounter.Text & "'"
cr.ReportFileName = "D:\Belajar MVB\slipthrkaryawan.rpt"
cr.WindowState = crptMaximized
cr.RetrieveDataFiles
cr.Action = 1
Call tampil
Call bersih
Call nonaktif
ctambah.Enabled = True


9. Double klik pada cbatal dan pastekan koding dibawah ini (declaration=click);
Call bersih
Call nonaktif
ctambah.Enabled = True

10. Double klik pada tidkaryawan dan pastekan koding dibawah ini (declaration=keypress);
If KeyAscii = 13 Then
Call koneksi
rsdatakaryawan.Open "select*from tabelkaryawan where idkaryawan='" & tidkaryawan.Text & "'", KON
With rsdatakaryawan
If rsdatakaryawan.EOF Then
MsgBox "ID tidak ditemukan", vbCritical
tidkaryawan.Text = ""
Else
tidkaryawan = UCase(tidkaryawan)
tnamakaryawan.Text = rsdatakaryawan.Fields("namakaryawan")
tjenisk.Text = rsdatakaryawan.Fields("jeniskelamin")
tnamakaryawan.Text = rsdatakaryawan.Fields("namakaryawan")
ttglmsk.Text = rsdatakaryawan.Fields("tglmasuk")
tstatus.Text = rsdatakaryawan.Fields("status")
tdivisi.Text = rsdatakaryawan.Fields("divisi")
tdepartemen.Text = rsdatakaryawan.Fields("departemen")
tjabatan.Text = rsdatakaryawan.Fields("jabatan")
tgolongan.Text = rsdatakaryawan.Fields("golongan")
tgapok.Text = rsdatakaryawan.Fields("gajipokok")
Call kodebonus
End If
End With

 End If


11. Double klik pada timer dan pastekan koding dibawah ini (declaration=click);
tjam.Text = Time
tgl.Text = Format(Date, "yyyy-mm-dd")