Laman

Selasa, 05 Juli 2011

PROGRAM VB

FORM  PRODUK















Private Sub CmdProses_Click(Index As Integer)
    Select Case Index
    Case 0
        Call hapus
        kdproduk.SetFocus
    Case 1
        If cmdproses(1).Caption = "simpan" Then
            ProsesDB 1
        Else
            ProsesDB 2
        End If
    Case 2
        x = MsgBox("yakin!", vbYesNo)
        If x = vbYes Then ProsesDB 3
    Case 3
        Call hapus
        kdproduk.SetFocus
    Case 4
        Unload Me
        End Select
    End Sub

Private Sub Form_Load()
    satuan.AddItem "unit"
    satuan.AddItem "buah"
    satuan.AddItem "set"
    Call hapus
    OPENDB
End Sub

Sub hapus()
    kdproduk = ""
    nama = ""
    satuan = ""
    jumlah = ""
    RubahCMD True, False, False, True
    cmdproses(1).Caption = "simpan"
End Sub

Private Sub kdproduk_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If kdproduk.Text = "" Then Exit Sub
        SQL = "select*from produk " & _
            "where kdproduk='" & kdproduk.Text & "'"
        If RS.State = adStateOpen Then RS.Close
        RS.Open SQL, Db, adOpenDynamic, adLockBatchOptimistic
        If RS.RecordCount <> 0 Then
            Call showDB
            RubahCMD False, True, True, True
        Else
            x = kdproduk
            Call hapus
            kdproduk = x
            RubahCMD False, True, False, True
            cmdproses(1).Caption = "simpan"
        End If
        nama.SetFocus
        End If
        End Sub
Sub showDB()
    With RS
        nama = !nama
        satuan = !satuan
        jumlah = !jumlah
    End With
    cmdproses(1).Caption = "edit"
End Sub

Sub ProsesDB(Log As Byte)
    Select Case Log
    Case 1
        SQL = "INSERT INTO produk(kdproduk,nama,satuan,jumlah)" & _
        "values('" & kdproduk.Text & "','" & _
                     nama.Text & "','" & _
                     satuan.Text & "','" & _
                     jumlah.Text & "')"
    Case 2
        SQL = "update produk set nama='" & nama.Text & "'," & _
                "satuan='" & satuan.Text & "'," & _
                "jumlah='" & jumlah.Text & "' " & _
                "where kdproduk='" & kdproduk.Text & "'"
    Case 3
        SQL = "Delete from produk where kdproduk='" & kdproduk.Text & "'"
    End Select
    Db.Execute SQL, adCmdText
    Adodc1.Refresh
    Call hapus
    kdproduk.SetFocus
End Sub

Sub RubahCMD(L0 As Boolean, L1 As Boolean, L2 As Boolean, L3 As Boolean)
    cmdproses(0).Enabled = L0
    cmdproses(1).Enabled = L1
    cmdproses(2).Enabled = L2
    cmdproses(3).Enabled = L3
End Sub

FORM PELANGGAN















Sub hapus()
    kdpelanggan.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 pelanggan(kdpelanggan, nama, alamat, telp)" & _
                " values('" & kdpelanggan.Text & _
                "','" & nama.Text & _
                "','" & alamat.Text & _
                "','" & telp.Text & "')"
        Case 1
          
            SQL = "UPDATE pelanggan SET nama ='" & nama.Text & "'," & _
                  " alamat = '" & alamat.Text & "'," & _
                  " telp = '" & telp.Text & "' " & _
                  " where kdpelanggan ='" & kdpelanggan.Text & "'"
        Case 2
            SQL = "DELETE FROM pelanggan WHERE kdpelanggan='" & kdpelanggan.Text & "'"
    End Select
    MsgBox "Pemorosesan RECORD Database telah berhasil...!", vbInformation, "Data pelanggan"
    Db.Execute SQL, adCmdTable
    Call hapus
    Adodc1.Refresh
    kdpelanggan.SetFocus
End Sub

Sub Tampilpelanggan()
    On Error Resume Next
   kdpelanggan.Text = RS!kdpelanggan
    nama.Text = RS!nama
    alamat.Text = RS!alamat
    telp.Text = RS!telp
End Sub

Private Sub CmdProses_Click(Index As Integer)
Select Case Index
    Case 0
        Call hapus
        kdpelanggan.SetFocus
    Case 1
        If cmdproses(1).Caption = "&Simpan" Then
            Call ProsesDB(0)
        Else
            Call ProsesDB(1)
        End If
    Case 2
        x = MsgBox("Yakin RECORD pelanggan Akan Dihapus...!", vbQuestion + vbYesNo, "pelanggan")
        If x = vbYes Then ProsesDB 2
        Call hapus
        kdpelanggan.SetFocus
    Case 3
        Call hapus
        kdpelanggan.SetFocus
    Case 4
        Unload Me
    End Select
End Sub

Private Sub Form_Load()
    Call OPENDB
    Call hapus  
End Sub

Private Sub kdpelanggan_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If kdpelanggan.Text = "" Then
            MsgBox "Masukkan kdpelanggan pelanggan !", vbInformation, "pelanggan"
            kdpelanggan.SetFocus
            Exit Sub
        End If
        SQL = "SELECT * FROM pelanggan WHERE kdpelanggan='" & kdpelanggan.Text & "'"
        If RS.State = adStateOpen Then RS.Close
        RS.Open SQL, Db, adOpenDynamic, adLockOptimistic
        If RS.RecordCount <> 0 Then
            Tampilpelanggan
            Call RubahCMD(Me, False, True, True, True)
            cmdproses(1).Caption = "&Edit"
            kdpelanggan.Enabled = False
        Else
            x = kdpelanggan.Text
            Call hapus
            kdpelanggan.Text = x
            Call RubahCMD(Me, False, True, False, True)
            cmdproses(1).Caption = "&Simpan"
        End If
        nama.SetFocus
    End If
End Sub

FORM PENJUALAN















Private Sub Form_Load()
    Call OPENDB
    Call hapus
    Call tampilkdproduk
    Call tampilkdpelanggan
End Sub

Sub hapus()
    nobukti = ""
    tanggal = Format(Now, "mm/dd/yyyy")
    kdproduk = ""
    nama = ""
    satuan = ""
    jumlah = ""
    kdpelanggan = ""
    cmdproses(1).Caption = "&Simpan"
    Call RubahCMD(Me, True, False, False, False) 
End Sub

Sub tampilkdproduk()
    SQL = "select kdproduk from produk"
    If RS.State = adStateOpen Then RS.Close
    RS.Open SQL, Db, adOpenDynamic, adLockOptimistic
    If RS.RecordCount <> 0 Then
    Do While Not RS.EOF
        kdproduk.AddItem RS!kdproduk
        RS.MoveNext
    Loop
    End If
End Sub

Sub tampilkdpelanggan()
    SQL = "select kdpelanggan from pelanggan"
    If RS.State = adStateOpen Then RS.Close
    RS.Open SQL, Db, adOpenDynamic, adLockOptimistic
    If RS.RecordCount <> 0 Then
    Do While Not RS.EOF
        kdpelanggan = RS!kdpelanggan
        RS.MoveNext
    Loop
    End If
End Sub

Private Sub kdproduk_Click()
    SQL = "select * from produk where kdproduk='" & kdproduk.Text & "'"
    If RS.State = adStateOpen Then RS.Close
    RS.Open SQL, Db, adOpenDynamic, adLockOptimistic
    If RS.RecordCount <> 0 Then
        nama = RS!nama
        satuan = RS!satuan
        jumlah = RS!jumlah
    End If
End Sub

Private Sub nobukti_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If nobukti = "" Then Exit Sub
        SQL = " select * from penjualan " & _
            "where nobukti='" & nobukti & "'"
        If RS.State = adStateOpen Then RS.Close
        RS.Open SQL, Db, adOpenDynamic, adLockOptimistic
        If RS.RecordCount <> 0 Then
            showDB
            Call RubahCMD(Me, False, True, True, True)
            cmdproses(1).Caption = "Edit"
        Else
            x = nobukti
            Call hapus
            nobukti = x
            Call RubahCMD(Me, False, True, False, True)
        End If
            kdproduk.SetFocus
        End If          
End Sub

Sub showDB()
    nobukti = RS!nobukti
    tanggal = Format(RS!tanggal, "mm/dd/yyyy")
    kdproduk = RS!kdproduk
    jumlah = RS!jumlah
    kdpelanggan = RS!kdpelanggan
    Call kdproduk_Click
End Sub
Sub ProsesDB(Log As Byte)
   Select Case Log
        Case 0
            SQL = "INSERT INTO penjualan(nobukti, tanggal,kdpelanggan, kdproduk, jumlah)" & _
                " values('" & nobukti.Text & _
                "','" & kdproduk.Text & _
                "','" & jumlah.Text & _
                "','" & kdpelanggan.Text & _
                "','" & tanggal.Text & "')"
        Case 1
            ctgl = Mid(tanggal.Text, 7, 4) & "-" & Mid(tanggal.Text, 4, 2) & "-" & Mid(tanggal.Text, 1, 2)
          
            SQL = "UPDATE penjualan SET kdproduk ='" & kdproduk.Text & "'," & _
                  " jumlah = '" & jumlah.Text & "'," & _
                  " tanggal= '" & tanggal.Text & "'," & _
                  " kdpelanggan = '" & kdpelanggan & "' " & _
                  " where nobukti ='" & nobukti.Text & "'"
        Case 2
            SQL = "DELETE FROM penjualan WHERE nobukti='" & nobukti.Text & "'"
    End Select
    MsgBox "Pemorosesan RECORD Database telah berhasil...!", vbInformation, "Data penjualan"
    Db.Execute SQL, adCmdTable
    Call hapus
   nobukti.SetFocus
End Sub


Private Sub CmdProses_Click(Index As Integer)
Select Case Index
    Case 0
        Call hapus
        nobukti.SetFocus
    Case 1
        If cmdproses(1).Caption = "&Simpan" Then
            Call ProsesDB(0)
        Else
            Call ProsesDB(1)
        End If
    Case 2
        x = MsgBox("Yakin RECORD gaji Akan Dihapus...!", vbQuestion + vbYesNo, "penjualan")
        If x = vbYes Then ProsesDB 2
        Call hapus
        nobukti.SetFocus
    Case 3
        Call hapus
        nobukti.SetFocus
    Case 4
        Unload Me
    End Select
End Sub

LAPORAN PRODUK















LAPORAN PELANGGAN















LAPORAN PENJUALAN

Tidak ada komentar:

Posting Komentar