Pada posting kali ini admin akan melakukan sharing tentang kode program aplikasi penjualan dan pembelian alat optik.
Kode Program dibuat menggunakan Bahasa Pemrograman Visual Basic 6. Untuk lebih jelasnya berikut tampilan program form input data barang.
Listing Code Program sebagai berikut :
Dim dataasal As Database
Dim tabelasal As Recordset
Dim isibaru As String
Dim tfi, tft As String
Private Sub Form_Load()
Set dataasal = OpenDatabase(App.Path & "\jualbeli.mdb")
Set tabelasal = dataasal.OpenRecordset("barang", dbOpenDynaset)
Set Data1.Recordset = tabelasal
If tabelasal.RecordCount > 0 Then
tft = "True"
Call aturtombol(tft)
Call isiantampil
Else
tft = "False"
Call aturtombol(tft)
baru.Enabled = True
tutup.Enabled = True
Call isiankosong
End If
tfi = "False"
Call aturisian(tfi)
isibaru = "T"
End Sub
Private Sub baru_Click()
Dim nourut As Integer
Dim kodebaru As String
Dim info, dasar, batasan As String
If baru.Caption = "&Baru" Then
baru.Caption = "&Simpan"
baru.ToolTipText = "Menyimpan Data"
rubah.Caption = "&Batal"
rubah.ToolTipText = "Membatalkan Data"
isibaru = "Y"
Call isiankosong
DBGrid1.Enabled = False
tfi = "True"
Call aturisian(tfi)
tft = "False"
Call aturtombol(tft)
baru.Enabled = True
rubah.Enabled = True
Text1.SetFocus
Else
If Text1.Text = " " Or Text2.Text = " " Then
p = MsgBox("Kode Barang atau Nama Barang belum diisi...!", vbOKOnly + vbInformation, "Informasi")
Else
dasar = Text1.Text
batasan = "kdbrg='" & dasar & "'"
tabelasal.FindFirst batasan
If tabelasal.NoMatch Then
tabelasal.AddNew
Call simpanisian
tabelasal.Update
Else
tabelasal.Edit
Call simpanisian
tabelasal.Update
End If
baru.Caption = "&Baru"
baru.ToolTipText = "Mengisi Data Baru"
rubah.Caption = "&Rubah"
rubah.ToolTipText = "Merubah Data"
tft = "True"
Call aturtombol(tft)
tfi = "False"
Call aturisian(tfi)
tabelasal.MoveLast
Set Data1.Recordset = tabelasal
DBGrid1.Enabled = True
DBGrid1.ReBind
isibaru = "T"
End If
End If
End Sub
Private Sub rubah_Click()
If rubah.Caption = "&Rubah" Then
baru.Caption = "&Simpan"
baru.ToolTipText = "Menyimpan Data"
rubah.Caption = "&Batal"
rubah.ToolTipText = "Membatalkan Data"
tfi = "True"
Call aturisian(tfi)
tft = "False"
Call aturtombol(tft)
baru.Enabled = True
rubah.Enabled = True
Text1.Enabled = False
Text2.SetFocus
Else
baru.Caption = "&Baru"
baru.ToolTipText = "Mengisi Data Baru"
rubah.Caption = "&Rubah"
rubah.ToolTipText = "Merubah Data"
If tabelasal.RecordCount > 0 Then
tft = "True"
Call aturtombol(tft)
Call isiantampil
Else
tft = "False"
Call aturtombol(tft)
baru.Enabled = True
tutup.Enabled = True
Call isiankosong
End If
tfi = "False"
Call aturisian(tfi)
DBGrid1.Enabled = True
isibaru = "T"
End If
End Sub
Private Sub hapus_Click()
Dim hapus
hapus = MsgBox("Yakin akan dihapus ?", 4 + 32, "Konfirmasi")
If hapus = 6 Then
If tabelasal.EOF = False Then
tabelasal.Delete
If tabelasal.RecordCount > 0 Then
tabelasal.MoveNext
Else
tabelasal.MoveFirst
End If
Set Data1.Recordset = tabelasal
DBGrid1.ReBind
End If
End If
End Sub
Private Sub tutup_Click()
Unload Me
End Sub
Private Sub DBGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
If isibaru = "T" Then
Call isiantampil
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Len(Trim(Text1.Text)) > 7 Then
MsgBox ("Isian tidak valid, maksimal 7 karakter")
Text1.SetFocus
Else
Text2.SetFocus
End If
End If
End Sub
Private Sub text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Len(Trim(Text2.Text)) > 10 Then
MsgBox ("Isian tidak valid, maksimal 10 karakter")
Text2.SetFocus
Else
Text3.SetFocus
End If
End If
End Sub
Private Sub text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Len(Trim(Text3.Text)) > 30 Then
MsgBox ("Isian tidak valid, maksimal 30 karakter!")
Text3.SetFocus
Else
Text4.SetFocus
End If
End If
End Sub
Private Sub text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Len(Trim(Text4.Text)) > 20 Then
MsgBox ("Isian tidak valid, maksimal 20 karakter!")
Text4.SetFocus
Else
Text5.SetFocus
End If
End If
End Sub
Private Sub text5_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Len(Trim(Text5.Text)) > 15 Then
MsgBox ("Isian tidak valid, maksimal 15 karakter!")
Text5.SetFocus
Else
Text6.SetFocus
End If
End If
End Sub
Private Sub text6_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Len(Trim(Text6.Text)) > 3 Then
MsgBox ("Isian tidak valid, maksimal 3 karakter!")
Text6.SetFocus
Else
Text7.SetFocus
End If
End If
End Sub
Private Sub text7_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Len(Trim(Text7.Text)) > 4 Then
MsgBox ("Isian tidak valid, maksimal 4 karakter!")
Text7.SetFocus
Else
Text8.SetFocus
End If
End If
End Sub
Private Sub text8_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Len(Trim(Text8.Text)) > 3 Then
MsgBox ("Isian tidak valid, maksimal 3 karakter!")
Text8.SetFocus
Else
Text9.SetFocus
End If
End If
End Sub
Private Sub text9_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Len(Trim(Text9.Text)) > 4 Then
MsgBox ("Isian tidak valid, maksimal 4 karakter!")
Text9.SetFocus
Else
Text10.SetFocus
End If
End If
End Sub
Private Sub text10_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Len(Trim(Text10.Text)) > 2 Then
MsgBox ("Isian tidak valid, maksimal 2 karakter!")
Text10.SetFocus
Else
Text11.SetFocus
End If
End If
End Sub
Private Sub text11_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Text12.SetFocus
End If
End Sub
Private Sub text12_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Text13.SetFocus
End If
End Sub
Private Sub text13_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
baru.SetFocus
End If
End Sub
Private Sub isiankosong()
Text1.Text = " "
Text2.Text = " "
Text3.Text = " "
Text4.Text = " "
Text5.Text = " "
Text6.Text = " "
Text7.Text = " "
Text8.Text = " "
Text9.Text = " "
Text10.Text = " "
Text11.Text = 0
Text12.Text = 0
Text13.Text = 0
End Sub
Public Sub simpanisian()
With tabelasal
!kdbrg = Text1.Text
!jenis = Text2.Text
!merek = Text3.Text
!bahan = Text4.Text
!model = Text5.Text
!sph = Text6.Text
!aadd = Text7.Text
!cyl = Text8.Text
!aaxis = Text9.Text
!pd = Text10.Text
!hargab = Text11.Text
!hargaj = Text12.Text
!stok = Text13.Text
On Error GoTo 0
End With
End Sub
Public Sub isiantampil()
If tabelasal.EOF = False Then
Text1.Text = tabelasal("kdbrg")
Text2.Text = tabelasal("jenis")
Text3.Text = tabelasal("merek")
Text4.Text = tabelasal("bahan")
Text5.Text = tabelasal("model")
Text6.Text = tabelasal("sph")
Text7.Text = tabelasal("aadd")
Text8.Text = tabelasal("cyl")
Text9.Text = tabelasal("aaxis")
Text10.Text = tabelasal("pd")
Text11.Text = tabelasal("hargab")
Text12.Text = tabelasal("hargaj")
Text13.Text = tabelasal("stok")
Else
Call isiankosong
End If
End Sub
Public Sub aturisian(tfi)
Text1.Enabled = tfi
Text2.Enabled = tfi
Text3.Enabled = tfi
Text4.Enabled = tfi
Text5.Enabled = tfi
Text6.Enabled = tfi
Text7.Enabled = tfi
Text8.Enabled = tfi
Text9.Enabled = tfi
Text10.Enabled = tfi
Text11.Enabled = tfi
Text12.Enabled = tfi
Text13.Enabled = tfi
End Sub
Public Sub aturtombol(tft)
baru.Enabled = tft
rubah.Enabled = tft
hapus.Enabled = tft
tutup.Enabled = tft
End Sub
0 Response to "Code Program Input Data Barang (Sistem Penjualan dan Pembelian Alat Optik)"
Posting Komentar