Untuk kasus lihat disini kasus
Listing program
Module :
Public DB As New ADODB.Connection
Public RS As New ADODB.Recordset
Public RS2 As New ADODB.Recordset
Public SQL As String
Sub opendb()
If DB.State = adStateOpen Then DB.Close
DB.CursorLocation = adUseClient
DB.Open "provider=microsoft.jet.OLEDB.4.0;Data source=c:\belajarserver\test.mdb;persist security info=false"
End Sub
Sub clearform(f As From)
Dim ctl As Control
For Each ctl In f
If TypeOf ctl Is TextBox Then ctl.Text = ""
If TypeOf ctl Is ComboBox Then ctl.Text = ""
Next
End Sub
Sub center(f As Form)
f.Move (Screen.Width - f.Width) / 2, (Screen.Height - f.Height) / 4
End Sub
Sub rubahcmd(f As Form, lo As Boolean, l1 As Boolean, l2 As Boolean, l3 As Boolean)
f.cmdproses(0).Enabled = l0
f.cmdproses(1).Enabled = l1
f.cmdproses(2).Enabled = l2
f.cmdproses(3).Enabled = l3
End Sub
Form Barang :
Private Sub Command1_Click()
Adodc1.Refresh
End Sub
Sub hapus()
kode.Enabled = True
clearform Me
Call rubahcmd(Me, True, False, False, False)
cmdproses(1).Caption = "&simpan"
End Sub
Sub prosesdb(log As Byte)
Select Case log
Case 0
SQL = "INSERT INTO barang(kode,nama,harga)" & _
"values('" & kode.Text & _
"','" & nama.Text & _
"','" & harga.Text & "')"
Case 1
SQL = "UPDATE barang SET nama='" & nama.Text & "'," & _
"harga=" ' & harga.text & '" " & _
"where kode='" & kode.text & "'"
Case 2
SQL -"DELETE FROM barang WHERE kode='" & kode.Text & "' "
End Select
MsgBox "Pemrosesan RECORD Database Telah Berhasil...!!!", vbInformation, "data barang"
DB.BeginTrans
DB.Execute SQL, adCmdTable
DB.CommitTrans
Call hapus
Adodc1.Refresh
kode.SetFocus
End Sub
Sub tampilbarang()
On Error Resume Next
kode.Text = RS!kode
nama.Text = RS!nama
harga.Text = RS!harga
End Sub
Private Sub cmdproses_click(index As Integer)
Select Case index
Case 0
Call hapus
kode.SetFocus
Case 1
If cmdproses(1).Caption = "&simpan" Then
Call prosesdb(0)
Else
callprosesdb (1)
End If
Case 2
x = MsgBox("Yakin RECORD barang akan dihapus...???", vbQuestion + vbYesNo, "barang")
If x = vbYes Then prosesdb 2
Call hapus
kode.SetFocus
Case 3
Call hapus
kode.SetFocus
Case 5
Adodc1.Refresh
Case 4
Unload Me
End Select
End Sub
Private Sub Form_Load()
Call opendb
Call hapus
End Sub
Private Sub kode_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If kode.Text = "" Then
MsgBox "Masukkan kode Barang !", vbInformation, "Barang"
kode.SetFocus
Exit Sub
End If
SQL = "select*from barang where kode='" & kode.Text & "'"
If RS.State = adStateOpen Then RS.Close
RS.Open SQL, DB, adOpenDynamic, adLockOptimistic
If RS.RecordCount <> 0 Then
tampilbarang
Call rubahcmd(Me, False, True, True, True)
cmdproses(1).Caption = "&Edit"
kode.Enabled = False
Else
x = kode.Text
Call hapus
kode.Text = x
Call rubahcmd(Me, False, True, False, True)
cmdproses(1).Caption = "&Simpan"
End If
nama.SetFocus
End If
End Sub
Hasil program
Tidak ada komentar:
Posting Komentar