Senin, 04 Juli 2011
LISTING PROGRAM FRM PEMBANTU CRISTAL REPORT 1-3 SAMA
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
LISTING PROGRAM MENU
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=barang"
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
LISTING PROGRAM 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
LISTING PROGRAM 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
Langganan:
Postingan (Atom)