Get Gifs at CodemySpace.com

Mengenai Saya

Foto saya
seorang mahasiswa dr budi darma

Minggu, 03 Juli 2011

listing program

LISTING PROGRAM FORM PRODUK
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


LISTING FORM PELANGGAN
Sub hapus()
kd_pelanggan.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 pelanggan(kd_pelanggan, nama, alamat, telp)" & _
" values('" & kd_pelanggan.Text & _
"','" & nama.Text & _
"','" & alamat.Text & _
"','" & telp.Text & "')"
Case 1

SQL = "UPDATE pelanggan SET Nama ='" & nama.Text & "'," & _
" alamat = '" & alamat.Text & "'," & _
" telp = '" & telp.Text & "'," & _
" where kd_pelanggan ='" & kd_pelanggan.Text & "'"
Case 2
SQL = "DELETE FROM pelanggan WHERE kd_pelanggan='" & kd_pelanggan.Text & "'"
End Select
MsgBox "Pemorosesan RECORD Database telah berhasil...!", vbInformation, "Data pelanggan"
Db.Execute SQL, adCmdTable
Call hapus
Adodc1.Refresh
kd_pelanggan.SetFocus
End Sub

Sub Tampilpelanggan()
On Error Resume Next
kd_pelanggan.Text = RS!kd_pelanggan
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
kd_pelanggan.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, "pelanggan")
If x = vbYes Then prosesDB 2
Call hapus
kd_pelanggan.SetFocus
Case 3
Call hapus
kd_pelanggan.SetFocus
Case 4
Unload Me
End Select
End Sub

Private Sub Form_Load()
Call OPENDB
Call hapus


End Sub

Private Sub kd_pelanggan_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If kd_pelanggan.Text = "" Then
MsgBox "Masukkan kd_pelanggan produk !", vbInformation, "pelanggan"
kd_pelanggan.SetFocus
Exit Sub
End If
SQL = "SELECT * FROM pelanggan WHERE kd_pelanggan='" & kd_pelanggan.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"
kd_pelanggan.Enabled = False
Else
x = kd_pelanggan.Text
Call hapus
kd_pelanggan.Text = x
Call RubahCMD(Me, False, True, False, True)
cmdproses(1).Caption = "&baru"
End If
nama.SetFocus
End If
End Sub




LISTING FORM PENJUALAN
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

Tidak ada komentar:

Posting Komentar