
Home, Forum diskusi, Chatting, Download

Latihan 3

Judul : Menggunakan Data Kontrol untuk pengolahan data

1. Tanamkan kontrol-kontrol pada Form anda sehingga membentuk tampilan berikut :

Kontrol	Properti	Nilai
Form1	Name Caption	frmForumID Pengolahan Data Forum Diskusi Indoprog
Label1	Caption	ForumID
Label2	Caption	Keterangan
Label3	Caption	Alamat Forum
Data1	Name DatabaseName RecordSource BOFAction EOFAction	RsForum C:\Modul9\Indoprog.mdb Forum MoveFirst MoveLast
Text1	Name DataSource DataField	txtForumID RsForum ForumID
Text2	Name DataSource DataField	txtKeterangan RsForum Keterangan
Text3	Name DataSource DataField	txtAlamat RsForum Alamat
Command1	Name Caption	cmdAdd &Add
Command2	Name Caption	cmdEdit &Edit
Command3	Name Caption	cmdDelete &Delete
Command4	Name Caption	cmdUpdate &Update
Command5	Name Caption	cmdCancel &Cancel
Command6	Name Caption	cmdFirst &First
Command7	Name Caption	cmdPrev &Previous
Command8	Name Caption	cmdNext &Next
Command9	Name Caption	cmdLast &Last

2. 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 Kunci(x)
txtForumID.Locked = x           'Kunci textbox dari
txtKeterangan.Locked = x        'perubahan oleh pemakai
txtAlamat.Locked = x
End Sub

Private Sub AturTombol(Add, Edit, Delete, Update, Cancel)
cmdAdd.Enabled = Add            'Atur keaktifan
cmdEdit.Enabled = Edit          'tombol
cmdDelete.Enabled = Delete
cmdUpdate.Enabled = Update
cmdCancel.Enabled = Cancel
End Sub

3. Lakukan koding untuk menangani Event pada Data kontrol

Private Sub RsForum_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 RsForum_Reposition()
If Flag = flNone Then
   If RsForum.Recordset.EOF Then      'Jika tabel kosong
      Call AturTombol(True, False, False, False, False)
      cmdFirst.Enabled = False
      cmdPrev.Enabled = False
      cmdNext.Enabled = False
      cmdLast.Enabled = False
   Else
      Call AturTombol(True, True, True, False, False)
      cmdFirst.Enabled = True
      cmdPrev.Enabled = True
      cmdNext.Enabled = True
      cmdLast.Enabled = True
   End If
   Call Kunci(True)
End If
End Sub

Private Sub RsForum_Validate(Action As Integer, Save As Integer)
Select Case Action
    Case vbDataActionAddNew
    Case vbDataActionMoveFirst
        Flag = flNone
    Case vbDataActionMovePrevious
        Flag = flNone
    Case vbDataActionMoveNext
        Flag = flNone
    Case vbDataActionMoveLast
        Flag = flNone
End Select
End Sub

3. Lakukan koding untuk masing-masing tombol

Private Sub cmdAdd_Click()
Flag = flAdd                 'Tandai sebagai tambah data
RsForum.Recordset.AddNew
Call Kunci(False)            'Buka penguncian
Call AturTombol(False, False, False, True, True)
txtForumID.SetFocus
End Sub

Private Sub cmdEdit_Click()
Flag = flEdit
RsForum.Recordset.Edit
Call Kunci(False)
Call AturTombol(False, False, False, True, True)
End Sub

Private Sub cmdDelete_Click()
On Error GoTo ErrCmdDelete_Click    'Error handle kalau tabel telah kosong
RsForum.Recordset.Delete            'Hapus data, dan record menjadi invalid
RsForum.Recordset.MoveNext          'Pindah kerecord berikutnya     
If RsForum.Recordset.EOF Then       'Jika EOF
   RsForum.Recordset.MoveLast       'Pindah kerecord terakhir
End If
Exit Sub
ErrCmdDelete_Click:
Select Case Err.Number
    Case 3021
    MsgBox "Data telah kosong", vbOKOnly + vbInformation, "Warning"
End Select
End Sub

Private Sub cmdUpdate_Click()
On Error GoTo ErrUpdate_click
If txtForumID.Text = "" Then
   MsgBox "Forum ID tidak boleh kosong", vbCritical, "Warning"
   Exit Sub
End If
If txtKeterangan.Text = "" Then
   MsgBox "Keterangan tidak boleh kosong", vbCritical, "Warning"
   Exit Sub
End If
If txtAlamat.Text = "" Then
   MsgBox "Alamat tidak boleh kosong", vbCritical, "Warning"
   Exit Sub
End If
RsForum.Recordset.Update
Flag = flNone
Call Kunci(True)
Call AturTombol(True, True, True, False, False)
RsForum.Recordset.Bookmark = RsForum.Recordset.LastModified
Exit Sub
ErrUpdate_click:
Select Case Err.Number
    Case 3022
    MsgBox "Telah terjadi duplikasi pada Forum ID", vbOKOnly + vbInformation, "Warning"
    Case Else
    MsgBox Err.Number & vbCrLf & Err.Description
End Select
End Sub

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

Private Sub cmdFirst_Click()
RsForum.Recordset.MoveFirst
End Sub

Private Sub cmdPrev_Click()
RsForum.Recordset.MovePrevious
If RsForum.Recordset.BOF Then
   RsForum.Recordset.MoveFirst
End If
End Sub

Private Sub cmdNext_Click()
RsForum.Recordset.MoveNext
If RsForum.Recordset.EOF Then
   RsForum.Recordset.MoveLast
End If
End Sub

Private Sub cmdLast_Click()
RsForum.Recordset.MoveLast
End Sub

Dibuat oleh hendra@indoprog.com
Medan - Sumatera Utara
Indonesia