Minggu, 29 Januari 2012

jawaban no 2 (Eva irayani saragih)

Listing Program Server

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
    Adodc1.Refresh
    Call hapus
    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
            Call prosesdb(1)
        End If
       
    Case 2
        x = MsgBox("yakin RECORD barang akan di hapus...!", vbQuestion + vbYesNo, "barang")
        If x = vbYes Then prosesdb 2
        Call hapus
        kode.SetFocus
    Case 3
        Call hapus
        kode.SetFocus
    Case 4
        Unload Me
    Case 5
        Adodc1.Refresh
    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 "masukan 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, adopendymic, 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, True, True)
            cmdproses(1).Caption = "&simpan"
        End If
        nama.SetFocus
    End If
   
End Sub


LISTING MODULE SERVER

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:\pertemuan X\test.mdb;Persist Security Info=False"
End Sub

Sub clearform(f As Form)
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, l0 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

Hasil Program