. Hariyadi: Juli 2011

Senin, 04 Juli 2011

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=MSDASQL.1;Persist Security Info=False;Data Source=tokoku"
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
Private Sub F1_Click()
    Form1.Show
  
End Sub

Private Sub F2_Click()
Form2.Show

End Sub

Private Sub F3_Click()
Form3.Show

End Sub

Private Sub mnC1_Click()
Form4.Show

End Sub

Private Sub mnC2_Click()
Form5.Show
End Sub

Private Sub mnc3_Click()
Form6.Show

End Sub
Dim Report As New CrystalReport3

Private Sub Form_Load()
Screen.MousePointer = vbHourglass
CRViewer1.ReportSource = Report
CRViewer1.ViewReport
Screen.MousePointer = vbDefault

End Sub

Private Sub Form_Resize()
CRViewer1.Top = 0
CRViewer1.Left = 0
CRViewer1.Height = ScaleHeight
CRViewer1.Width = ScaleWidth

End Sub
Dim Report As New CrystalReport1

Private Sub Form_Load()
Screen.MousePointer = vbHourglass
CRViewer1.ReportSource = Report
CRViewer1.ViewReport
Screen.MousePointer = vbDefault

End Sub

Private Sub Form_Resize()
CRViewer1.Top = 0
CRViewer1.Left = 0
CRViewer1.Height = ScaleHeight
CRViewer1.Width = ScaleWidth

End Sub
Dim Report As New CrystalReport2

Private Sub Form_Load()
Screen.MousePointer = vbHourglass
CRViewer1.ReportSource = Report
CRViewer1.ViewReport
Screen.MousePointer = vbDefault

End Sub

Private Sub Form_Resize()
CRViewer1.Top = 0
CRViewer1.Left = 0
CRViewer1.Height = ScaleHeight
CRViewer1.Width = ScaleWidth

End Sub
Sub hapus()
    no_bukti.Enabled = True
    ClearFORM Me
    Call RubahCMD(Me, True, False, False, False)
    cmdproses(1).Caption = "&baru"
End Sub

Sub prosesDB(Log As Byte)
   Select Case Log
        Case 0
            SQL = "INSERT INTO penjualan(no_bukti, tgl, kd_pelanggan,kd_produk,jumlah)" & _
                " values('" & no_bukti.Text & _
                "','" & tgl.Text & _
                "','" & kd_pelanggan.Text & _
                "','" & kd_produk.Text & _
                "','" & jumlah.Text & "')"
        Case 1
           
            SQL = "UPDATE produk SET tgl ='" & tgl.Text & "'," & _
                  " kd_pelanggan = '" & kd_pelanggan.Text & "'," & _
                  " kd_produk = '" & kd_produk.Text & "'," & _
                  " jumlah = '" & jumlah.Text & "'," & _
                  " where no_bukti ='" & no_bukti.Text & "'"
        Case 2
            SQL = "DELETE FROM penjualan WHERE no_bukti='" & no_bukti.Text & "'"
    End Select
    MsgBox "Pemorosesan RECORD Database telah berhasil...!", vbInformation, "Data penjualan"
    Db.Execute SQL, adCmdTable
    Call hapus
    Adodc1.Refresh
    no_bukti.SetFocus
End Sub

Sub Tampilpenjualan()
    On Error Resume Next
    no_bukti.Text = RS!no_bukti
    tgl.Text = RS!tgl
    kd_pelanggan.Text = RS!kd_pelanggan
    kd_produk.Text = RS!kd_produk
    jumlah.Text = RS!jumlah
   
End Sub

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

Private Sub Form_Load()
    Call OPENDB
    Call hapus
   
   
End Sub

Private Sub no_bukti_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If no_bukti.Text = "" Then
            MsgBox "Masukkan no_bukti penjualan !", vbInformation, "penjualan"
            no_bukti.SetFocus
            Exit Sub
        End If
        SQL = "SELECT * FROM produk WHERE no_bukti='" & no_bukti.Text & "'"
        If RS.State = adStateOpen Then RS.Close
        RS.Open SQL, Db, adOpenDynamic, adLockOptimistic
        If RS.RecordCount <> 0 Then
            Tampilpenjualan
            Call RubahCMD(Me, False, True, True, True)
            cmdproses(1).Caption = "&Edit"
            no_bukti.Enabled = False
        Else
            x = no_bukti.Text
            Call hapus
            no_bukti.Text = x
            Call RubahCMD(Me, False, True, False, True)
            cmdproses(1).Caption = "&baru"
        End If
        tgl.SetFocus
    End If
End Sub
Private Sub Form_Load()
    Call OPENDB
    Call hapus
   
   
End Sub

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

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

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

Sub prosesDB(Log As Byte)
   Select Case Log
        Case 0
            SQL = "INSERT INTO produk(kd_produk, nama, satuan, jumlah)" & _
                " values('" & kd_produk.Text & _
                "','" & nama.Text & _
                "','" & satuan.Text & _
                "','" & jumlah.Text & "')"
        Case 1
           
            SQL = "UPDATE produk SET Nama ='" & nama.Text & "'," & _
                  " satuan = '" & satuan.Text & "'," & _
                  " jumlah = '" & jumlah.Text & "'," & _
                  " where kd_produk ='" & kd_produk.Text & "'"
        Case 2
            SQL = "DELETE FROM produk WHERE kd_produk='" & kd_produk.Text & "'"
    End Select
    MsgBox "Pemorosesan RECORD Database telah berhasil...!", vbInformation, "Data produk"
    Db.Execute SQL, adCmdTable
    Call hapus
    Adodc1.Refresh
    kd_produk.SetFocus
End Sub

Sub Tampilproduk()
    On Error Resume Next
    kd_produk.Text = RS!kd_produk
    nama.Text = RS!nama
    satuan.Text = RS!satuan
    jumlah.Text = RS!jumlah
   
End Sub

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

Private Sub Form_Load()
    Call OPENDB
    Call hapus
   
   
End Sub

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

TUGAS QUIS