Minggu, 29 Januari 2012

Postingan jawaban no 2 (Siti Walian Mursida)

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