Setelah kita melihat contoh aplikasi jadwal penerimaan siswa gres sekolah mengemudi memakai visual basic 6.0, selanjutnya kita akan menciptakan form data jam latihan.
Pertama-tama buat terlebih dahulu formnya menyerupai dibawah ini, juga beri name masing-masing :
A. Tambahkan crystalreport beri name "cr"
B. tambahkan tabel grid, beri name "grid"
1. Klik pada cb1 dan pastekan koding berikut (ubah deklarasi ke click ):
cb2.Enabled = True
cb1.Enabled = False
cb1.Enabled = False
2. Klik pada cb2 dan pastekan koding berikut (ubah deklarasi ke click ):
tinput.Text = cb1 + ":" + cb2
Call koneksi
rsjam.Open "select*from tjam where jam='" & tinput.Text & "'", KON
If rsjam.EOF Then
tinput.Text = cb1 + ":" + cb2
Call aktifsimpan
Else
MsgBox "Jam yang dimasukkan sudah terisi", vbCritical
cb2.Enabled = False
cb1.Enabled = True
cb1.SetFocus
cbsimpan.Enabled = False
End If
Call koneksi
rsjam.Open "select*from tjam where jam='" & tinput.Text & "'", KON
If rsjam.EOF Then
tinput.Text = cb1 + ":" + cb2
Call aktifsimpan
Else
MsgBox "Jam yang dimasukkan sudah terisi", vbCritical
cb2.Enabled = False
cb1.Enabled = True
cb1.SetFocus
cbsimpan.Enabled = False
End If
3. Klik pada cbtambah dan pastekan koding berikut (ubah deklarasi ke click ):
Call koneksi
Call bersih
Call aktif
rsjam.Open "select*from tjam order by kodejam desc", KON
With rsjam
If .BOF And .EOF Then
tkodejam.Text = "KJM" + "01"
Else
tkodejam.Text = "KJM" + Right(Str(Val(Right(.Fields("kodejam"), 2)) + 101), 2)
End If
End With
tkodejam.Enabled = False
tinput.Enabled = False
cbbatal.Enabled = True
cbsunting.Enabled = False
cbperbarui.Enabled = False
cbhapus.Enabled = False
Call tampil
cbsimpan.Enabled = False
cbtambah.Enabled = False
cb2.Enabled = False
cb1.SetFocus
Call bersih
Call aktif
rsjam.Open "select*from tjam order by kodejam desc", KON
With rsjam
If .BOF And .EOF Then
tkodejam.Text = "KJM" + "01"
Else
tkodejam.Text = "KJM" + Right(Str(Val(Right(.Fields("kodejam"), 2)) + 101), 2)
End If
End With
tkodejam.Enabled = False
tinput.Enabled = False
cbbatal.Enabled = True
cbsunting.Enabled = False
cbperbarui.Enabled = False
cbhapus.Enabled = False
Call tampil
cbsimpan.Enabled = False
cbtambah.Enabled = False
cb2.Enabled = False
cb1.SetFocus
4. Klik pada cbsimpan dan pastekan koding berikut (ubah deklarasi ke click ):
If tinput.Text = "" Then
MsgBox "Data Belum dimasukkan", vbCritical
Else
Call koneksi
rsjam.Open "insert into tjam set kodejam='" & tkodejam & "',jam='" & tinput & "'", KON
MsgBox "Data Sudah Tersimpan", vbInformation
Call tampil
Call bersih
Call nonaktif
cbtambah.Enabled = True
End If
MsgBox "Data Belum dimasukkan", vbCritical
Else
Call koneksi
rsjam.Open "insert into tjam set kodejam='" & tkodejam & "',jam='" & tinput & "'", KON
MsgBox "Data Sudah Tersimpan", vbInformation
Call tampil
Call bersih
Call nonaktif
cbtambah.Enabled = True
End If
5. Klik pada cbsunting dan pastekan koding berikut (ubah deklarasi ke click ):
Call koneksi
rsjam.Open "select*from tjam where kodejam ='" & tcari.Text & "'", KON
With rsjam
tkodejam.Text = .Fields("kodejam")
tinput.Text = .Fields("jam")
End With
Call aktif
tinput.Enabled = False
tkodejam.Enabled = False
cbtambah.Enabled = False
cbsimpan.Enabled = False
cbhapus.Enabled = False
cbsunting.Enabled = False
cb2.Enabled = False
rsjam.Open "select*from tjam where kodejam ='" & tcari.Text & "'", KON
With rsjam
tkodejam.Text = .Fields("kodejam")
tinput.Text = .Fields("jam")
End With
Call aktif
tinput.Enabled = False
tkodejam.Enabled = False
cbtambah.Enabled = False
cbsimpan.Enabled = False
cbhapus.Enabled = False
cbsunting.Enabled = False
cb2.Enabled = False
6. Klik pada cbperbarui dan pastekan koding berikut (ubah deklarasi ke click ):
Call koneksi
rsjam.Open "select*from tjam where jam='" & tinput.Text & "'", KON
If rsjam.EOF Then
Call perbarui
Else
MsgBox "Jam yang dimasukkan sudah terisi", vbCritical
cb2.Enabled = False
cb1.Enabled = True
End If
rsjam.Open "select*from tjam where jam='" & tinput.Text & "'", KON
If rsjam.EOF Then
Call perbarui
Else
MsgBox "Jam yang dimasukkan sudah terisi", vbCritical
cb2.Enabled = False
cb1.Enabled = True
End If
7. Klik pada cbhapus dan pastekan koding berikut (ubah deklarasi ke click ):
Call koneksi
a = MsgBox("Yakin Ingin Hapus Data ini?", vbQuestion + vbYesNo, "tanya")
If a = vbYes Then
rsjam.Open "delete from tjam where kodejam='" & tcari.Text & "'", KON
MsgBox "Data telah terhapus", vbInformation
bersih
tcari.Text = ""
Call nonaktif
cbtambah.Enabled = True
End If
Call tampil
a = MsgBox("Yakin Ingin Hapus Data ini?", vbQuestion + vbYesNo, "tanya")
If a = vbYes Then
rsjam.Open "delete from tjam where kodejam='" & tcari.Text & "'", KON
MsgBox "Data telah terhapus", vbInformation
bersih
tcari.Text = ""
Call nonaktif
cbtambah.Enabled = True
End If
Call tampil
8. Klik pada cbbatal dan pastekan koding berikut (ubah deklarasi ke click ):
Call bersih
Call nonaktif
cbtambah.Enabled = True
Call nonaktif
cbtambah.Enabled = True
9. Klik pada cetak dan pastekan koding berikut (ubah deklarasi ke click ):
cr.ReportFileName = "D:\Perkuliahan\Tugas Akhir\Tugas Akhir\program\Laporan\datajam.rpt"
cr.WindowState = crptMaximized
cr.RetrieveDataFiles
cr.Action = 1
cr.WindowState = crptMaximized
cr.RetrieveDataFiles
cr.Action = 1
10. Klik pada bmenu dan pastekan koding berikut (ubah deklarasi ke click ):
a = MsgBox("Yakin Untuk Menutup Form Ini Dan kembali ke Menu Utama ?", vbCritical + vbYesNo, "INFO")
If a = vbYes Then
fjamlatihan.Hide
Call aktifadmin
End If
If a = vbYes Then
fjamlatihan.Hide
Call aktifadmin
End If
11. Klik pada cbcari dan pastekan koding berikut (ubah deklarasi ke click ):
Call koneksi
rsjam.Open "select*from tjam where kodejam='" & tcari.Text & "'", KON
If rsjam.EOF Then
MsgBox "Data Tidak Ditemukan", vbCritical
Call bersih
tcari.Text = ""
tcari.SetFocus
Else
With rsjam
tkodejam.Text = .Fields("kodejam")
tinput.Text = .Fields("jam")
End With
Call nonaktif
tkodejam.Enabled = False
cbsunting.Enabled = True
cbhapus.Enabled = True
cbbatal.Enabled = True
End If
rsjam.Open "select*from tjam where kodejam='" & tcari.Text & "'", KON
If rsjam.EOF Then
MsgBox "Data Tidak Ditemukan", vbCritical
Call bersih
tcari.Text = ""
tcari.SetFocus
Else
With rsjam
tkodejam.Text = .Fields("kodejam")
tinput.Text = .Fields("jam")
End With
Call nonaktif
tkodejam.Enabled = False
cbsunting.Enabled = True
cbhapus.Enabled = True
cbbatal.Enabled = True
End If
12. Buat SUB perbarui dan pastekan koding berikut :
Call koneksi
rsjam.Open "update tjam set jam='" & tinput & "' where kodejam='" & tkodejam.Text & "'", KON
MsgBox "Data Berhasil di Update", vbInformation, "Info"
bersih
Call tampil
Call nonaktif
cbtambah.Enabled = True
rsjam.Open "update tjam set jam='" & tinput & "' where kodejam='" & tkodejam.Text & "'", KON
MsgBox "Data Berhasil di Update", vbInformation, "Info"
bersih
Call tampil
Call nonaktif
cbtambah.Enabled = True
13. Buat SUB aktifadmin dan pastekan koding berikut :
fmenu.mlog.Enabled = True
fmenu.mganti.Enabled = True
fmenu.mdata.Enabled = True
fmenu.mdatauser.Enabled = True
fmenu.mdatabiaya.Enabled = True
fmenu.mdatasiswa.Enabled = False
fmenu.mriwayat.Enabled = True
fmenu.mlogout.Enabled = True
fmenu.mloguser.Enabled = False
fmenu.mmobil.Enabled = True
fmenu.mjam.Enabled = True
fmenu.mganti.Enabled = True
fmenu.mdata.Enabled = True
fmenu.mdatauser.Enabled = True
fmenu.mdatabiaya.Enabled = True
fmenu.mdatasiswa.Enabled = False
fmenu.mriwayat.Enabled = True
fmenu.mlogout.Enabled = True
fmenu.mloguser.Enabled = False
fmenu.mmobil.Enabled = True
fmenu.mjam.Enabled = True
14. Buat form_load dan pastekan koding berikut :
Call bersih
Call nonaktif
Call tampil
cbtambah.Enabled = True
Me.Height = 8205
Me.Width = 11700
tinput.MaxLength = 8
Me.Left = 100
Me.Top = 0
Call tambahjam
Call nonaktif
Call tampil
cbtambah.Enabled = True
Me.Height = 8205
Me.Width = 11700
tinput.MaxLength = 8
Me.Left = 100
Me.Top = 0
Call tambahjam
15. Buat SUB tambahjam dan pastekan koding berikut :
cb2.AddItem ("00")
cb2.AddItem ("01")
cb2.AddItem ("02")
cb2.AddItem ("03")
cb2.AddItem ("04")
cb2.AddItem ("05")
cb2.AddItem ("06")
cb2.AddItem ("07")
cb2.AddItem ("08")
cb2.AddItem ("09")
cb2.AddItem ("10")
cb2.AddItem ("11")
cb2.AddItem ("12")
cb2.AddItem ("13")
cb2.AddItem ("14")
cb2.AddItem ("15")
cb2.AddItem ("16")
cb2.AddItem ("17")
cb2.AddItem ("18")
cb2.AddItem ("19")
cb2.AddItem ("20")
cb2.AddItem ("21")
cb2.AddItem ("22")
cb2.AddItem ("23")
cb2.AddItem ("24")
cb2.AddItem ("25")
cb2.AddItem ("26")
cb2.AddItem ("27")
cb2.AddItem ("28")
cb2.AddItem ("29")
cb2.AddItem ("30")
cb2.AddItem ("31")
cb2.AddItem ("32")
cb2.AddItem ("33")
cb2.AddItem ("34")
cb2.AddItem ("35")
cb2.AddItem ("36")
cb2.AddItem ("37")
cb2.AddItem ("38")
cb2.AddItem ("39")
cb2.AddItem ("40")
cb2.AddItem ("40")
cb2.AddItem ("41")
cb2.AddItem ("42")
cb2.AddItem ("43")
cb2.AddItem ("44")
cb2.AddItem ("45")
cb2.AddItem ("46")
cb2.AddItem ("47")
cb2.AddItem ("48")
cb2.AddItem ("49")
cb2.AddItem ("50")
cb2.AddItem ("51")
cb2.AddItem ("52")
cb2.AddItem ("53")
cb2.AddItem ("54")
cb2.AddItem ("55")
cb2.AddItem ("56")
cb2.AddItem ("57")
cb2.AddItem ("58")
cb2.AddItem ("59")
cb2.AddItem ("01")
cb2.AddItem ("02")
cb2.AddItem ("03")
cb2.AddItem ("04")
cb2.AddItem ("05")
cb2.AddItem ("06")
cb2.AddItem ("07")
cb2.AddItem ("08")
cb2.AddItem ("09")
cb2.AddItem ("10")
cb2.AddItem ("11")
cb2.AddItem ("12")
cb2.AddItem ("13")
cb2.AddItem ("14")
cb2.AddItem ("15")
cb2.AddItem ("16")
cb2.AddItem ("17")
cb2.AddItem ("18")
cb2.AddItem ("19")
cb2.AddItem ("20")
cb2.AddItem ("21")
cb2.AddItem ("22")
cb2.AddItem ("23")
cb2.AddItem ("24")
cb2.AddItem ("25")
cb2.AddItem ("26")
cb2.AddItem ("27")
cb2.AddItem ("28")
cb2.AddItem ("29")
cb2.AddItem ("30")
cb2.AddItem ("31")
cb2.AddItem ("32")
cb2.AddItem ("33")
cb2.AddItem ("34")
cb2.AddItem ("35")
cb2.AddItem ("36")
cb2.AddItem ("37")
cb2.AddItem ("38")
cb2.AddItem ("39")
cb2.AddItem ("40")
cb2.AddItem ("40")
cb2.AddItem ("41")
cb2.AddItem ("42")
cb2.AddItem ("43")
cb2.AddItem ("44")
cb2.AddItem ("45")
cb2.AddItem ("46")
cb2.AddItem ("47")
cb2.AddItem ("48")
cb2.AddItem ("49")
cb2.AddItem ("50")
cb2.AddItem ("51")
cb2.AddItem ("52")
cb2.AddItem ("53")
cb2.AddItem ("54")
cb2.AddItem ("55")
cb2.AddItem ("56")
cb2.AddItem ("57")
cb2.AddItem ("58")
cb2.AddItem ("59")
16. Buat SUB aktif dan pastekan koding berikut :
tkodejam.Enabled = True
tinput.Enabled = True
cbtambah.Enabled = True
cbsimpan.Enabled = True
cbsunting.Enabled = True
cbhapus.Enabled = True
cbperbarui.Enabled = True
cbbatal.Enabled = True
cb1.Enabled = True
cb2.Enabled = True
tinput.Enabled = True
cbtambah.Enabled = True
cbsimpan.Enabled = True
cbsunting.Enabled = True
cbhapus.Enabled = True
cbperbarui.Enabled = True
cbbatal.Enabled = True
cb1.Enabled = True
cb2.Enabled = True
17. Buat SUB nonaktif dan pastekan koding berikut :
tkodejam.Enabled = False
tinput.Enabled = False
cbtambah.Enabled = False
cbsimpan.Enabled = False
cbsunting.Enabled = False
cbhapus.Enabled = False
cbperbarui.Enabled = False
cbbatal.Enabled = False
cb1.Enabled = False
cb2.Enabled = False
18. Buat SUB higienis dan pastekan koding berikut :tinput.Enabled = False
cbtambah.Enabled = False
cbsimpan.Enabled = False
cbsunting.Enabled = False
cbhapus.Enabled = False
cbperbarui.Enabled = False
cbbatal.Enabled = False
cb1.Enabled = False
cb2.Enabled = False
tkodejam.Text = ""
tinput.Text = ""
tinput.Text = ""
19. Buat SUB tampil dan pastekan koding berikut :
Call koneksi
rsjam.Open "select*from tjam", KON
Set grid.DataSource = rsjam
rsjam.Open "select*from tjam", KON
Set grid.DataSource = rsjam
20. Buat SUB aktifsimpan dan pastekan koding berikut :
If cbperbarui.Enabled = True Then
cbsimpan.Enabled = False
Else
cbsimpan.Enabled = True
End If
cbsimpan.Enabled = False
Else
cbsimpan.Enabled = True
End If
Sumber http://www.hendrisetiawan.com