MODUL VISUAL BASIC ADO MERCUSUAR MEMBUAT DATABASE DENGAN ADO Untuk membuat program ini, buatlah database dengan menggunakan Microsoft Access versi 2000 ke atas. Ketentuannya sebagai berikut : Nama Database Nama Table Field
: BRG : Supplier : KodeSupplier (Text/6),NamaSupplier (Text/50), Alamat (Text/100), Phone (Text/20), HP (Text/15), Email (Text/50), Contact (Text/50) : KodeSupplier
Primary Key
Sebelum membuat form tambahkan komponen ADO Data Control dan Data Grid, lakukan langkah berikut : 1. Setelah membuat program (Standard EXE), muncul form 2. Klik menu Project, pilih Component, tandai dengan memberi tanda cek pada : a. Microsoft ADO Data Control 6.0 (OLDB) b. Microsoft Data Grid Control 6.0 (OLDB) 3. Akhiri dengan tekan tombol OK.
Form Layout :
Property Setting No 1
Object Form
2
Label1
Property Name Caption Caption Font
Seting frmSupplier Form Data Supplier Kode Supplier Arial [9]
No 14
Object Text4
15
Text5
Property Name Text Font Name
Seting txtPhone Arial [9] txtHP
MODUL VISUAL BASIC ADO MERCUSUAR 3
Label2
4
Label3
5
Label4
6
Label5
7
Label6
8
Label6
9
Text1
10
Text2
11
Text3
12
Adodc1
13
DataGrid1
Caption Font Caption Font Caption Font Caption Font Caption Font Caption Font Name Text Font Name Text Font Name Text Font Name Caption ConnectionString
Recordset Name RecordSource
Nama Arial [9] Alamat Arial [9] Phone Arial [9] HP Arial [9] E-Mail Arial [9] Contact Person Arial [9] txtKoSup
16
17
Text6
Text7
18
Command1
19
Command2
Arial [9] txtNaSup
20
Command3
Arial [9] txtAlm
21
Command4
Text Font Name Text Font Name Text Font Name Caption Font Name Caption Font Name Caption Font Name Caption Font
Arial [9] txtEmail Arial [9] txtCP Arial [9] cmdNew Baru Arial [9] cmdEdit Edit Arial [9] cmdDelete Hapus Arial [9] cmdEnd Keluar Arial [9]
Arial [9] AdoSup ADO : Supplier Klik …, klik Build, Pilih Microsoft Jet 4.0 OLDB, klik Next, klik …. Pilih/cari file database (BRG), pilih Open, Klik OK, Klik OK Select * From Supplier DGS AdoSup
CODE : Private Sub Form_Activate() txtKoSup.MaxLength = 6 AdoSup.Refresh NonAktif End Sub Private Sub Form_Load() 'menengahkan form ditengah-tengah layar frmSupplier.Top = (Screen.Height - Height) / 2 frmSupplier.Left = (Screen.Width - Width) / 2 End Sub 'subrutin yang dijalankan pada saat tombol aktif diklik Private Sub cmdNew_Click() 'jika tombol baru diklik, ubah menjadi tombol simpan If cmdNew.Caption = "Baru" Then cmdNew.Caption = "Simpan" cmdEdit.Enabled = False cmdDelete.Enabled = False 'tambahkan record kosong
MODUL VISUAL BASIC ADO MERCUSUAR AdoSup.Recordset.AddNew 'memanggil subrutin Aktif Aktif 'arahkan kursor pada textbox Kode txtKoSup.SetFocus Else 'ubah tombol Simpan menjadi tombol Baru cmdNew.Caption = "Baru" 'memanggil subrutin NonAktif NonAktif cmdEdit.Enabled = True cmdDelete.Enabled = True End If End Sub 'subrutin bila tombol Hapus diklik Private Sub cmdDelete_Click() Dim x As String 'buat pertanyaan sebelum dihapus x = MsgBox("Benar " & txtNaSup & "data ini mau dihapus?", vbYesNo + vbCritical, "Hapus") 'jika tombol Yes dipilih If x = vbYes Then 'hapus record AdoSup.Recordset.Delete 'perbarui database AdoSup.Refresh AdoSup.Recordset.MoveFirst DGS.ReBind DGS.Refresh End If End Sub 'subrutin bila tombol Edit diklik Private Sub cmdEdit_Click() 'jika tombol Edit diklik, ubah menjadi tombol Update If cmdEdit.Caption = "Edit" Then cmdEdit.Caption = "Update" cmdNew.Enabled = False cmdDelete.Enabled = False 'aktifkan form Aktif 'matikan textbox kode txtKoSup.Enabled = False 'arahkan kursor ke textbox nama barang txtNaSup.SetFocus Else 'ubah tombol update ke edit cmdEdit.Caption = "Edit" 'nonaktif kan form NonAktif cmdNew.Enabled = True cmdDelete.Enabled = True End If End Sub 'subrutin jika tombol keluar diklik Private Sub cmdEnd_Click()
MODUL VISUAL BASIC ADO MERCUSUAR Unload Me End Sub
'tutup form
'subrutin yang membuat form tidak bisa diisi Sub NonAktif() txtKoSup.Enabled = False txtNaSup.Enabled = False txtAlm.Enabled = False txtPhone.Enabled = False txtHP.Enabled = False txtEmail.Enabled = False txtCP.Enabled = False End Sub 'subrutin yang membuat form bisa diisi Sub Aktif() txtKoSup.Enabled = True txtNaSup.Enabled = True txtAlm.Enabled = True txtPhone.Enabled = True txtHP.Enabled = True txtEmail.Enabled = True txtCP.Enabled = True End Sub Private Sub txtKoSup_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then txtNaSup.SetFocus End If End Sub Private Sub txtNaSup_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then txtAlm.SetFocus End If End Sub Private Sub txtAlm_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then txtPhone.SetFocus End If End Sub Private Sub txtPhone_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then txtHP.SetFocus End If End Sub Private Sub txtHP_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then txtEmail.SetFocus End If End Sub Private Sub txtEmail_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then
MODUL VISUAL BASIC ADO MERCUSUAR txtCP.SetFocus End If End Sub Private Sub txtCP_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then If cmdNew.Enabled = True Then cmdNew.SetFocus Else cmdEdit.SetFocus End If End If End Sub
