Home, Forum diskusi, Chatting, Download

Latihan 3

Judul : Memanfaatkan beberapa Data Kontrol pada 1 Form untuk Validasi.

1. Buatlah Project Baru, dan Form Entri data untuk tabel Anggota dan tabel CD

Catatan : Limit mesti Numerik, Daftar mesti Tanggal, serta memperhatikan NOT NULL pada tabel

Catatan : Harga mesti Numerik, Daftar mesti Tanggal, serta memperhatikan NOT NULL pada tabel

2. Buatlah User Interface untuk Transaksi Peminjaman CD berikut, sehingga dapat menampilkan nama dan alamat sesuai dengan KodeAnggota dan Judul untuk KodeCD.

Untuk kontrol lainnya atur sendiri sesuai dengan tampilan diatas

Lakukan koding pada bagian General Declaration

'Deklarasi Enumerated type untuk aksi oleh pemakai
Private Enum Aksi
  flNone = 0
  flAdd = 1          		'Tambah data
  flEdit = 2         		'Perbaiki data
End Enum

'Deklarasi Variabel Flag adalah Aksi
Dim Flag As Aksi

Private Sub AturTombol(Add, Update, Cancel)
cmdAdd.Enabled = Add            'Atur keaktifan
cmdUpdate.Enabled = Update
cmdCancel.Enabled = Cancel
End Sub

Private Sub Kunci(x)
txtTanggal.Locked = x   	'Kunci textbox dari
txtKodeAnggota.Locked = x       'perubahan oleh pemakai
txtKodeCD.Locked = x
End Sub

Lakukan koding pada Form Load untuk mengatur Index masing-masing Data Kontrol

Private Sub Form_Load()
RsCD.Refresh                    'Refresh Data Kontrol RSCD
RsCD.Recordset.Index = "P_KEY"  'Tentukan Index yang digunakan
RsAnggota.Refresh
RsAnggota.Recordset.Index = "P_KEY"
RsTransaksi.Refresh
RsTransaksi.Recordset.LockEdits = False
End Sub

Lakukan koding pada Kontrol RsTransaksi

Private Sub RsTransaksi_Error(DataErr As Integer, Response As Integer)
Select Case DataErr
    Case 3163
         MsgBox "Panjang data melebihi ukuran field"
         Response = vbDataErrContinue
    Case Else
         Response = vbDataErrDisplay
End Select
End Sub

Private Sub RsTransaksi_Reposition()
RsAnggota.Recordset.Seek "=", txtKodeAnggota.Text
If Not RsAnggota.Recordset.NoMatch Then
   lblNama = RsAnggota.Recordset("Nama")
   lblAlamat = RsAnggota.Recordset("Alamat")
End If
RsCD.Recordset.Seek "=", txtKodeCD.Text
If Not RsCD.Recordset.NoMatch Then
   lblJudul = RsCD.Recordset("Judul")
End If
If Flag = flNone Then
   If RsTransaksi.Recordset.EOF Then      'Jika tabel kosong
      Call AturTombol(True, False, False)
      cmdFirst.Enabled = False
      cmdPrev.Enabled = False
      cmdNext.Enabled = False
      cmdLast.Enabled = False
   Else
      Call AturTombol(True, False, False)
      cmdFirst.Enabled = True
      cmdPrev.Enabled = True
      cmdNext.Enabled = True
      cmdLast.Enabled = True
   End If
   Call Kunci(True)
End If
End Sub

Lakukan koding pada Command Add Click untuk mengatur data tanggal dan membuka penguncian

Private Sub cmdAdd_Click()
Flag = flAdd                 'Tandai sebagai tambah data
RsTransaksi.Recordset.AddNew
Call Kunci(False)            'Buka penguncian
Call AturTombol(False, True, True)
txtTanggal.Text = Format(Date, "dd-mmm-yyyy")
txtTanggal.SetFocus
End Sub

Lakukan koding pada txtKodeAnggota LostFocus untuk mencari data anggota pada RsAnggota

Private Sub txtKodeAnggota_LostFocus()
If txtKodeAnggota.Text <> "" Then
   RsAnggota.Recordset.Seek "=", txtKodeAnggota.Text
   If Not RsAnggota.Recordset.NoMatch Then
      lblNama = RsAnggota.Recordset("Nama")
      lblAlamat = RsAnggota.Recordset("Alamat")
   Else
      MsgBox "Kode Anggota belum terdaftar !", vbCritical, "Warning"
      txtKodeAnggota.SetFocus
   End If
End If
End Sub

Lakukan hal yang sama untuk txtKodeCD

Private Sub txtKodeCD_LostFocus()
If txtKodeCD.Text <> "" Then
   RsCD.Recordset.Seek "=", txtKodeCD.Text
   If Not RsCD.Recordset.NoMatch Then
      lblJudul = RsCD.Recordset("Judul")
   Else
      MsgBox "Judul CD belum terdaftar !", vbCritical, "Warning"
      txtKodeCD.SetFocus
   End If
End If
End Sub

Lakukan Koding pada Command Update

Private Sub cmdUpdate_Click()
On Error GoTo ErrcmdUpdate_click
If txtKodeAnggota.Text = "" Then
   MsgBox "Kode Anggota tidak boleh kosong", vbCritical, "Warning"
   Exit Sub
End If
If txtKodeCD.Text = "" Then
   MsgBox "Kode CD tidak boleh kosong", vbCritical, "Warning"
   Exit Sub
End If
If Not IsDate(txtTanggal.Text) Then
   MsgBox "Periksa tanggal Peminjaman", vbCritical, "Warning"
End If

RsTransaksi.Recordset.Update
Flag = flNone
Call Kunci(True)
Call AturTombol(True, False, False)
RsTransaksi.Recordset.Bookmark = RsTransaksi.Recordset.LastModified
CancelcmdUpdate:
Exit Sub
ErrcmdUpdate_click:
Select Case Err.Number
    Case 3022
         MsgBox "Telah terjadi duplikasi pada Transaksi", vbOKOnly + vbInformation, "Warning"
    Case 3167
         MsgBox "Data telah dihapus pemakai lain" & vbCrLf & _
                "Lakukan refresh data anda !", vbOKOnly + vbInformation
    Case 3197
         'Data pada recordset telah berubah
         'sejak ditampilkan.
         MsgBox "Data telah diubah oleh pemakai lain !", vbOKOnly + vbInformation
         'Hal ini secara otomatis akan menyegarkan
         'kembali recordset untuk menampilkan data terakhir
         RsTransaksi.Recordset.Move 0
         Resume CancelcmdUpdate
    Case 3260
         'Record dikunci pemakai lain
         nHitung = nHitung + 1
         'Mencoba mengunci dua kali
         'Memungkinkan pemakai membuat keputusan ulangi, batal
         If nHitung > 2 Then
            nPilih = MsgBox("Data sedang dikunci pemakai lain" & vbCrLf & _
                            "Ulangi penguncian ?", vbYesNo + _
                            vbQuestion)
            If nPilih = vbYes Then
               nHitung = 1
            Else
               Resume CancelcmdUpdate
            End If
         End If
         DoEvents 'menjalankan event windows
         'menunda sejumlah waktu random
         nTunda = nHitung ^ 2 * Int(Rnd * 3000 + 1000)
         For i = 1 To nTunda: Next i
         Resume
    Case Else
         MsgBox "Error " & Err & ":" & Error, vbOKOnly
         Resume CancelcmdUpdate
End Select
End Sub

Dan Akhirnya koding untuk tombol Cancel

Private Sub cmdCancel_Click()
RsTransaksi.Recordset.CancelUpdate
Call Kunci(True)
Flag = flNone
Call AturTombol(True, False, False)
End Sub

Catatan :

Untuk Tombol Navigasi lakukan koding sendiri.