Sabtu, 03 Maret 2012

baik agan2  kali ini ane mw coba share gmn ngbuat 1 form menggunakan vb 6,disini form yang akan
kita buat adalah form entry data buku untuk program perpustakaan
pertama,kita harus buat database dulu dunk pastinya ,ok ane anggap agan2 udah bisa buat databasenya,
disini ane buat databasenya peke acces kedua,kita buat modul dulu karna disini
ane ngonekin db dengan formnya pake listing klik kanan d project,trus klik add module,
setelah tampil lalu agan isi dengan koding ini yah

Public Nama_Koneksi As String
Sub koneksi()
Nama_Koneksi = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\My Documents\Program Perpustakaan\Form\perpustakaanbsi2.mdb;Persist Security Info=False"
End Sub
"jangan lupa pas bikin db nya sesuaikan dengan db ane yah,biar gampang nantinya u/ yang ane tebelin itu nama db nya yah"

ok sekarang kita buat formnya,udah tau dunk cara buat formnya gimana,dah gitu tinggal masukin listingnya dech

COMPONENT :

textbox
datacombo
command button
datagrid
adodc
timer
frame
image

LISTING :


Dim c As Control
Dim Teks, Pesan As String

'Untuk merefresh agar data didatagrid muncul kembali
Sub Segar()
adobuku.RecordSource = "select * from buku"
adobuku.Refresh
End Sub

Sub Aktif()
For Each c In Me
     If TypeOf c Is TextBox Then c.Enabled = True
     Next c
     DataCombo1.Enabled = True
End Sub

Sub NonAktif()
For Each c In Me
     If TypeOf c Is TextBox Then c.Enabled = False
     Next c
     DataCombo1.Enabled = False
     Text1.Enabled = True
End Sub

Sub Simpan()
With adobuku.Recordset
     .Fields(0) = UCase(txtkd.Text)
     .Fields(1) = UCase(txtjudul.Text)
     .Fields(2) = UCase(txtpengarang.Text)
     .Fields(3) = UCase(txtpenerbit.Text)
     .Fields(4) = txttahun.Text
     .Fields(5) = UCase(DataCombo1.Text)
     .Update
End With
End Sub

Sub Tampil()
With adobuku.Recordset
     txtkd.Text = .Fields(0)
     txtjudul.Text = .Fields(1)
     txtpengarang.Text = .Fields(2)
     txtpenerbit.Text = .Fields(3)
     txttahun.Text = .Fields(4)
     DataCombo1.Text = .Fields(5)
End With
End Sub

Sub FormBersih()
For Each c In Me
     If TypeOf c Is TextBox Then c.Text = ""
     Next c
     DataCombo1.Text = "-PILIH-"
End Sub

Private Sub cmdbatal_Click()
Call NonAktif
Call FormBersih
Call Segar
cmdsimpan.Enabled = True
cmdhapus.Enabled = True
cmdubah.Caption = "Ubah"
End Sub

Private Sub cmdhapus_Click()
On Error GoTo errhapus

Pesan = MsgBox("Hapus data ini..?", vbYesNo + vbQuestion, "Info")
  
If Pesan = vbYes Then
     Call Aktif
     adobuku.Recordset.Delete
     Call FormBersih
     cmdsimpan.Enabled = True
     txtkd.SetFocus
Else
     Call NonAktif
     Call FormBersih
     cmdsimpan.Enabled = True
End If
     Call Segar
Exit Sub

errhapus:
MsgBox "Data gagal dihapus", vbCritical, "Peringatan"
End Sub

Private Sub cmdsimpan_Click()
On Error GoTo errsimpan

If txtkd.Text = "" Then txtkd.SetFocus: Exit Sub
If txtjudul.Text = "" Then txtjudul.SetFocus: Exit Sub
If txtpengarang.Text = "" Then txtpengarang.SetFocus: Exit Sub
If txtpenerbit.Text = "" Then txtpenerbit.SetFocus: Exit Sub
If txttahun.Text = "" Then txttahun.SetFocus: Exit Sub
If DataCombo1.Text = "-PILIH-" Then MsgBox "Anda belum memilih pilihan klasifikasi..!", vbCritical, "Peringatan": Exit Sub

'Proses Simpan
adobuku.Recordset.AddNew
Call Simpan
Call FormBersih
Pesan = MsgBox("Input data lagi..?", vbYesNo + vbQuestion, "Info")
If Pesan = vbYes Then
     txtkd.SetFocus
Else
     End
End If
Call Segar                                             'untuk merefresh agar data didatagrid muncul kembali
Exit Sub

errsimpan:
MsgBox "Maaf data error..!,kode buku sudah ada", vbCritical, "Peringatan"
End Sub
Private Sub cmdsimpan_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
   cmdsimpan_Click
End If
End Sub

Private Sub cmdtambah_Click()
Call Aktif
txtkd.SetFocus
End Sub

Private Sub cmdtampil_Click()
If cmdtampil.caption = "Tampilkan Tabel " Then      
     FrmEntryBuku.Height = 7680
     cmdtampil.caption = "Sembunyikan "
Else
     cmdtampil.caption = "Tampilkan Tabel "
     FrmEntryBuku.Height = 4815
End If
End Sub

'Proses edit
Private Sub cmdubah_Click()
On Error GoTo errubah

If cmdubah.Caption = "Ubah" Then
     Call Aktif
     cmdubah.Caption = "Update"
     cmdsimpan.Enabled = False
     cmdhapus.Enabled = False
Else
     Call Simpan                                           'setelah di edit lakukan proses simpan
     MsgBox "Data berhasil diubah", vbOKOnly, "Info"     'karena memakai ado jadi tidak memakai .addnew
     Call FormBersih
     Call NonAktif
     cmdubah.Caption = "Ubah"
     cmdsimpan.Enabled = True
     cmdhapus.Enabled = True
     Call Segar                                         'untuk merefresh agar data didatagrid muncul kembali
End If
                                                 
Exit Sub

errubah:
MsgBox "Gagal ubah data", vbCritical, "Peringatan"
End Sub

Private Sub Form_Activate()
Call NonAktif
Teks = FrmEntryBuku.Caption
FrmEntryBuku.Height = 4815
DataCombo1.Text = "-PILIH-"
End Sub

'Proses buka koneksi
Private Sub Form_Load()
koneksi                                                 'membuka koneksi saat form di jalankan
With adobuku
     .ConnectionString = Nama_Koneksi                   'koneksi dengan koneksi baru atau newadodb
     .RecordSource = "select * from buku"
     .CommandType = adCmdText
     .Refresh
End With
With Adoklasifikasi
     .ConnectionString = Nama_Koneksi
     .RecordSource = "select * from klasifikasi"
     .CommandType = adCmdText
     .Refresh
End With
With DataGrid1
     .Columns(0).Width = 1000                                'merubah ukuran kolom
     .Columns(1).Width = 4000
     .Columns(2).Width = 2000
     .Columns(3).Width = 2000
     .Columns(4).Width = 1000
End With
End Sub

'Proses edit (untuk mencari kode yang akan di edit)
Private Sub Text1_Change()
adobuku.RecordSource = "select * from buku where KdBuku like'" & Text1.Text & "'"
adobuku.Refresh
If adobuku.Recordset.RecordCount <> 0 Then
     Call Tampil
     Call NonAktif
     cmdsimpan.Enabled = False
End If
End Sub

'Proses jika data yang dicari tidak ditemukan
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 And adobuku.Recordset.RecordCount = 0 Then
     MsgBox "Data tidak ditemukan", vbCritical, "Peringatan"
     Call FormBersih
     Call Segar
End If
End Sub

'Proses teks berjalan d judul form
Private Sub Timer1_Timer()
Teks = Right(Teks, Len(Teks) - 1) & Left(Teks, 1)
FrmEntryBuku.Caption = Teks
End Sub

'Proses limit digit PK (Primary Key)
Private Sub txtkd_Change()
If Len(txtkd.Text) > 5 Then                               'jika pengisian textbox kode buku lebih dari 5 maka akan muncul pesan error
   MsgBox "Anda melebihi batas 5 digit..!!!", vbCritical, "Peringatan"
   txtkd.Text = ""
End If
End Sub



owh iah agan2 jangan lupa yah untuk penamaan componennya disamakan,dirubah juga boleh asal agan mau teliti
semoga bermanfaat yah
                                                             -SELAMAT MENCOBA-

Reaksi:
Categories:

2 komentar:

Subscribe to RSS Feed Follow me on Twitter!