(BELAJAR VB 6)
Posting kali ini kita akan membuat aplikasi program penerimaan siswa baru (PSB) dengan dilengkapi fitur foto siswa.
Untuk lebih jelasnya silahkan sobat simak tutorial berikut :
Step 1 : buatlah database menggunakan ms. Office Access seperti contoh berikut :
Step 2 : Jalankan VB6 sobat dan pada project baru pilihlah VB Enterprise Edition Control.
dan lanjutkan dengan membuat desain seperti gambar berikut :
Oh…ya….. tambah juga dua buah komponen lagi, yakni ADODC dan CommonDialog.
Step 3 : Buatlah module koneksi dengan cara klik Project – Add Module
Pada kotak dialog Module tuliskan code berikut :
Global conn As ADODB.Connection
Global rspsb As ADODB.Recordset
Sub koneksi()
On Error GoTo gagal:
Set conn = New ADODB.Connection
conn.Provider = "microsoft.jet.oledb.4.0"
conn.CursorLocation = adUseClient
conn.Open App.Path & "\DbPSB.mdb"
Exit Sub
gagal:
If (Err.Number = -2147467259) Then
MsgBox "Koneksi Aplikasi Ke Database Gagal...!", vbCritical, "Informasi"
End
End If
End Sub
Global rspsb As ADODB.Recordset
Sub koneksi()
On Error GoTo gagal:
Set conn = New ADODB.Connection
conn.Provider = "microsoft.jet.oledb.4.0"
conn.CursorLocation = adUseClient
conn.Open App.Path & "\DbPSB.mdb"
Exit Sub
gagal:
If (Err.Number = -2147467259) Then
MsgBox "Koneksi Aplikasi Ke Database Gagal...!", vbCritical, "Informasi"
End
End If
End Sub
Step 4
: klik 2x pada Form dan tuliskan code berikut diantara Private Sub
Form_Load() dan End Sub, code ini berfungsi untuk memanggil fungsi
module :
koneksi
dan
lanjutkan dengan dengan menuliskan code berikut tepat dibawah code
koneksi yang berfungsi untuk mengaktifkan ComboBox Kelamin dan ComboBox
Agama :
cmbKelamin.AddItem "Laki-Laki"
cmbKelamin.AddItem "Perempuan"
cmbAgama.AddItem "Islam"
cmbAgama.AddItem "Kr. Protestan"
cmbAgama.AddItem "Kr. Katolik"
cmbAgama.AddItem "Hindu"
cmbAgama.AddItem "Budha"
cmbKelamin.AddItem "Perempuan"
cmbAgama.AddItem "Islam"
cmbAgama.AddItem "Kr. Protestan"
cmbAgama.AddItem "Kr. Katolik"
cmbAgama.AddItem "Hindu"
cmbAgama.AddItem "Budha"
Step 5
: Buatlah sebuah code untuk membersihkan form dan mengembalikan kondisi
form dalam keaadaan awal. Caranya klik 2x form dan letakkan code
berikut ini di tempat kosong pada form. Code ini saya beri nama
"kosongkanform".
Private Sub kosongkanform()
txtNama.Text = ""
txtNis.Text = ""
cmbKelamin.Text = ""
txtTmp.Text = ""
cmbAgama.Text = ""
txtStatus.Text = ""
txtAnak.Text = ""
txtSaudara.Text = ""
txtSasal.Text = ""
txtNama.Enabled = True
cmdSimpan.Enabled = True
cmdEdit.Enabled = False
cmdHapus.Enabled = False
cmdCari.Enabled = False
End Sub
txtNama.Text = ""
txtNis.Text = ""
cmbKelamin.Text = ""
txtTmp.Text = ""
cmbAgama.Text = ""
txtStatus.Text = ""
txtAnak.Text = ""
txtSaudara.Text = ""
txtSasal.Text = ""
txtNama.Enabled = True
cmdSimpan.Enabled = True
cmdEdit.Enabled = False
cmdHapus.Enabled = False
cmdCari.Enabled = False
End Sub
Step 6.
Untuk mencari dan menampilkan foto masukkan code berikut dengan cara
klik 2x tombol “Cari Foto” dan masukkan code diantara Private Sub
cmdCari_Click() dan End Sub.
CommonDialog1.Filter = "Picture files (*.jpg;*.bmp;*.gif;*.png)|*.jpg;*.bmp;*.gif;*.png"
CommonDialog1.ShowOpen
Image1.Picture = LoadPicture(CommonDialog1.FileName)
Image1.Visible = True
CommonDialog1.ShowOpen
Image1.Picture = LoadPicture(CommonDialog1.FileName)
Image1.Visible = True
Step 7. Klik 2x txtNama.text, kemudian pada pilihlah mode “KeyPress”
Dan lanjutkan dengan menuliskan code berikut :
Private Sub txtNama_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Set rspsb = New ADODB.Recordset
rspsb.LockType = adLockOptimistic
rspsb.CursorType = adOpenDynamic
rspsb.Open "select * from nis", conn, , , adCmdText
rspsb.Filter = " Nama= '" & txtNama.Text & "'"
If Not rssiswa.EOF Then
cmdSimpan.Enabled = False
cmdEdit.Enabled = True
cmdHapus.Enabled = True
Image1.Visible = True
txtNama.Enabled = False
txtNis.Text = rspsb.Fields(1)
cmbKelamin.Text = rspsb.Fields(2)
txtTmp.Text = rspsb.Fields(3)
DTPicker1.Value = rspsb.Fields(4)
cmbAgama.Text = rspsb.Fields(5)
txtStatus.Text = rspsb.Fields(6)
txtAnak.Text = rspsb.Fields(7)
txtSaudara.Text = rspsb.Fields(8)
txtSasal.Text = rspsb.Fields(9)
CommonDialog1.FileName = rspsb.Fields(10)
Image1.Picture = LoadPicture(CommonDialog1.FileName)
If CommonDialog1.FileName = "" Then
Else
End If
End If
End If
End Sub
If KeyAscii = 13 Then
Set rspsb = New ADODB.Recordset
rspsb.LockType = adLockOptimistic
rspsb.CursorType = adOpenDynamic
rspsb.Open "select * from nis", conn, , , adCmdText
rspsb.Filter = " Nama= '" & txtNama.Text & "'"
If Not rssiswa.EOF Then
cmdSimpan.Enabled = False
cmdEdit.Enabled = True
cmdHapus.Enabled = True
Image1.Visible = True
txtNama.Enabled = False
txtNis.Text = rspsb.Fields(1)
cmbKelamin.Text = rspsb.Fields(2)
txtTmp.Text = rspsb.Fields(3)
DTPicker1.Value = rspsb.Fields(4)
cmbAgama.Text = rspsb.Fields(5)
txtStatus.Text = rspsb.Fields(6)
txtAnak.Text = rspsb.Fields(7)
txtSaudara.Text = rspsb.Fields(8)
txtSasal.Text = rspsb.Fields(9)
CommonDialog1.FileName = rspsb.Fields(10)
Image1.Picture = LoadPicture(CommonDialog1.FileName)
If CommonDialog1.FileName = "" Then
Else
End If
End If
End If
End Sub
Step 8. Klik 2x tombol Simpan (cmdSimpan) dan tuliskan code berikut :
Dim X
If txtNama.Text = "" Or txtNis.Text = "" Or cmbKelamin.Text = "" Or _
txtTmp.Text = "" Or DTPicker1.Value = "" Or cmbAgama.Text = "" Or _
txtStatus.Text = "" Or txtAnak.Text = "" Or txtSasal.Text = "" Then
MsgBox "Data Belum Lengkap", vbInformation, "Pesan"
Exit Sub
Else
X = MsgBox("Apakah Data Ingin Disimpan...?", vbQuestion + vbYesNo)
If X = vbYes Then
Set rspsb = New ADODB.Recordset
rspsb.LockType = adLockOptimistic
rspsb.CursorType = adOpenDynamic
rspsb.Open "SELECT * FROM siswa", conn, , , adCmdText
rspsb.AddNew
rspsb.Fields(0) = txtNama.Text
rspsb.Fields(1) = txtNis.Text
rspsb.Fields(2) = cmbKelamin.Text
rspsb.Fields(3) = txtTmp.Text
rspsb.Fields(4) = DTPicker1.Value
rspsb.Fields(5) = cmbAgama.Text
rspsb.Fields(6) = txtStatus.Text
rspsb.Fields(7) = txtAnak.Text
rspsb.Fields(8) = txtSaudara.Text
rspsb.Fields(9) = txtSasal.Text
rspsb.Fields(10) = CommonDialog1.FileName
rspsb.Update
MsgBox "Data Tersimpan...!", vbInformation, "Pesan"
kosongkanform
Image1.Visible = False
Else
Exit Sub
End If
End If
If txtNama.Text = "" Or txtNis.Text = "" Or cmbKelamin.Text = "" Or _
txtTmp.Text = "" Or DTPicker1.Value = "" Or cmbAgama.Text = "" Or _
txtStatus.Text = "" Or txtAnak.Text = "" Or txtSasal.Text = "" Then
MsgBox "Data Belum Lengkap", vbInformation, "Pesan"
Exit Sub
Else
X = MsgBox("Apakah Data Ingin Disimpan...?", vbQuestion + vbYesNo)
If X = vbYes Then
Set rspsb = New ADODB.Recordset
rspsb.LockType = adLockOptimistic
rspsb.CursorType = adOpenDynamic
rspsb.Open "SELECT * FROM siswa", conn, , , adCmdText
rspsb.AddNew
rspsb.Fields(0) = txtNama.Text
rspsb.Fields(1) = txtNis.Text
rspsb.Fields(2) = cmbKelamin.Text
rspsb.Fields(3) = txtTmp.Text
rspsb.Fields(4) = DTPicker1.Value
rspsb.Fields(5) = cmbAgama.Text
rspsb.Fields(6) = txtStatus.Text
rspsb.Fields(7) = txtAnak.Text
rspsb.Fields(8) = txtSaudara.Text
rspsb.Fields(9) = txtSasal.Text
rspsb.Fields(10) = CommonDialog1.FileName
rspsb.Update
MsgBox "Data Tersimpan...!", vbInformation, "Pesan"
kosongkanform
Image1.Visible = False
Else
Exit Sub
End If
End If
Step 9. Klik 2x tombol Edit (cmdEdit) dan tuliskan code berikut :
Dim a
a = MsgBox("Edit Data...?", vbQuestion + vbYesNo, "Pesan")
If a = vbYes Then
rspsb.Fields(1) = txtNis.Text
rspsb.Fields(2) = cmbKelamin.Text
rspsb.Fields(3) = txtTmp.Text
rspsb.Fields(4) = DTPicker1.Value
rspsb.Fields(5) = cmbAgama.Text
rspsb.Fields(6) = txtStatus.Text
rspsb.Fields(7) = txtAnak.Text
rspsb.Fields(8) = txtSaudara.Text
rspsb.Fields(9) = txtSasal.Text
rspsb.Fields(10) = CommonDialog1.FileName
rspsb.Update
MsgBox "Data Berhasil Di Edit..!!", vbInformation, "Info"
kosongkanform
txtNama.SetFocus
Image1.Visible = False
Else
Exit Sub
End If
Step 8. Klik 2x tombol Hapus (cmdHapus) dan tuliskan code berikut :
Dim Y
Y = MsgBox("Apakah Data Ingin Dihapus..?", vbQuestion + vbYesNo)
If Y = vbYes Then
rspsb.Delete
MsgBox "Data Berhasil Dihapus..!!", vbInformation, "info"
kosongkanform
txtNama.SetFocus
Else
Exit Sub
End If
a = MsgBox("Edit Data...?", vbQuestion + vbYesNo, "Pesan")
If a = vbYes Then
rspsb.Fields(1) = txtNis.Text
rspsb.Fields(2) = cmbKelamin.Text
rspsb.Fields(3) = txtTmp.Text
rspsb.Fields(4) = DTPicker1.Value
rspsb.Fields(5) = cmbAgama.Text
rspsb.Fields(6) = txtStatus.Text
rspsb.Fields(7) = txtAnak.Text
rspsb.Fields(8) = txtSaudara.Text
rspsb.Fields(9) = txtSasal.Text
rspsb.Fields(10) = CommonDialog1.FileName
rspsb.Update
MsgBox "Data Berhasil Di Edit..!!", vbInformation, "Info"
kosongkanform
txtNama.SetFocus
Image1.Visible = False
Else
Exit Sub
End If
Step 8. Klik 2x tombol Hapus (cmdHapus) dan tuliskan code berikut :
Dim Y
Y = MsgBox("Apakah Data Ingin Dihapus..?", vbQuestion + vbYesNo)
If Y = vbYes Then
rspsb.Delete
MsgBox "Data Berhasil Dihapus..!!", vbInformation, "info"
kosongkanform
txtNama.SetFocus
Else
Exit Sub
End If
Step 10. Klik 2x tombol Hapus (cmdHapus) dan tuliskan code berikut :
Dim Y
Y = MsgBox("Apakah Data Ingin Dihapus..?", vbQuestion + vbYesNo)
If Y = vbYes Then
rspsb.Delete
MsgBox "Data Berhasil Dihapus..!!", vbInformation, "info"
kosongkanform
txtNama.SetFocus
Else
Exit Sub
End If
Y = MsgBox("Apakah Data Ingin Dihapus..?", vbQuestion + vbYesNo)
If Y = vbYes Then
rspsb.Delete
MsgBox "Data Berhasil Dihapus..!!", vbInformation, "info"
kosongkanform
txtNama.SetFocus
Else
Exit Sub
End If
Step Terakhir. Klik 2x tombol Tutup (cmdTutup) dan masukkan code berikut :
Dim X
X = MsgBox("Apakah Anda Ingin Keluar..?", vbQuestion + vbYesNo, App.Title)
If X = vbYes Then
Unload Me
Else
Cancel = 1
End If
X = MsgBox("Apakah Anda Ingin Keluar..?", vbQuestion + vbYesNo, App.Title)
If X = vbYes Then
Unload Me
Else
Cancel = 1
End If
Yup….. aplikasi sudah selesai.
Buat sobat yang ingin download source codenya silahkan klik disini….
0 comments:
Post a Comment