VISUAL BASIC, Pembuatan Form Penjualan Tiket Kereta




Langkah Awal untuk pembuatan form ini, buka program Visual Basic 6.0, Untuk databasenya, gwe pake Ms. Access 2000 yang udah tersedia di dalam aplikasi VB itu sendiri,....
Rancang Formnya seperti gambar di atas,...

kemudian masukan listingnya seperti di bawah ini.

Sub aktif()
txtnotran.Enabled = True
txtkode.Enabled = True
txtnama.Enabled = True
cbojurusan.Enabled = True
txtharga.Enabled = True
txtjml.Enabled = True
txttotal.Enabled = True
cmdtambah.Enabled = True
cmdsimpan.Enabled = True
cmdbatal.Enabled = True
End Sub

Sub nonaktif()
txtnotran.Enabled = False
txtkode.Enabled = False
txtnama.Enabled = False
cbojurusan.Enabled = False
txtharga.Enabled = False
txtjml.Enabled = False
txttotal.Enabled = False
cmdtambah.Enabled = True
cmdsimpan.Enabled = False
cmdbatal.Enabled = False
End Sub

Sub bersih()
txtnotran = ""
txtkode = ""
txtnama = ""
cbojurusan = ""
txtharga = ""
txtjml = ""
txttotal = ""
txtcari = ""
End Sub

Sub tampil()
txtnotran = Data1.Recordset!Notrans
txtkode = Data1.Recordset!Kdkereta
txtnama = Data1.Recordset!Nmkereta
cbojurusan = Data1.Recordset!Jurusan
txtharga = Data1.Recordset!Harga
txtjml = Data1.Recordset!Jumlahpesan
txttotal = Data1.Recordset!Total
End Sub

Private Sub cbojurusan_Click()
Select Case cbojurusan.ListIndex
Case 0
txtharga = 290000
Case 1
txtharga = 150000
Case 2
txtharga = 120000
Case 3
txtharga = 156000
Case 4
txtharga = 155000
End Select
txtjml.SetFocus
End Sub

Private Sub cmdbatal_Click()
bersih
aktif
txtnotran.SetFocus
End Sub

Private Sub cmdfirst_Click()
Data1.Recordset.MoveFirst
tampil
MsgBox "AWAL RECORD", vbInformation, "INFO"
End Sub

Private Sub cmdkeluar_Click()
pesan = MsgBox("Yakin Ingin Keluar?", vbQuestion + vbYesNo, "PESAN")
If pesan = vbYes Then
Unload Me
frmmenu.Visible = True
End If
End Sub

Private Sub cmdlast_Click()
Data1.Recordset.MoveLast
tampil
MsgBox " AKHIR RECORD", vbInformation, "INFO"
End Sub

Private Sub cmdnext_Click()
On Error Resume Next
Data1.Recordset.MoveNext
tampil
If Data1.Recordset.EOF Then
MsgBox "SUDAH DI AKHIR RECORD", vbExclamation, "INFO"
Data1.Recordset.MoveLast
End If
End Sub

Private Sub cmdprev_Click()
On Error Resume Next
Data1.Recordset.MovePrevious
tampil
If Data1.Recordset.BOF Then
MsgBox "SUDAH DI AWAL RECORD", vbExclamation, "INFO"
Data1.Recordset.MoveFirst
End If
End Sub

Private Sub cmdsimpan_Click()
Data1.Recordset.AddNew
Data1.Recordset!Notrans = txtnotran
Data1.Recordset!Kdkereta = txtkode
Data1.Recordset!Nmkereta = txtnama
Data1.Recordset!Jurusan = cbojurusan
Data1.Recordset!Harga = txtharga
Data1.Recordset!Jumlahpesan = txtjml
Data1.Recordset!Total = txttotal
Data1.Recordset.Update
MsgBox "Data TERSIMPAN", vbInformation
End Sub

Private Sub cmdtambah_Click()
aktif
bersih
txtnotran.SetFocus
End Sub

Private Sub Command1_Click()
Data1.Recordset.Index = "Notrans"
Data1.Recordset.Seek "=", txtcari.Text
If Data1.Recordset.NoMatch Then
MsgBox "Data Tidak ditemukan", vbInformation
bersih
txtnotran.SetFocus
Else
tampil
End If
End Sub

Private Sub Form_Load()
cbojurusan.AddItem "SURABAYA"
cbojurusan.AddItem "JOGJAKARTA"
cbojurusan.AddItem "BANDUNG"
cbojurusan.AddItem "SOLO"
cbojurusan.AddItem "SEMARANG"
nonaktif
bersih
End Sub

Private Sub txtcari_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Data1.Recordset.Index = "Notrans"
Data1.Recordset.Seek "=", txtcari.Text
If Data1.Recordset.NoMatch Then
MsgBox "Data Tidak ditemukan", vbInformation, "INFO"
bersih
aktif
txtcari.SetFocus
Else
tampil
End If
End If
End Sub

Private Sub txtjml_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txttotal = Val(txtharga) * Val(txtjml)
End If
End Sub
Private Sub txtnama_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cbojurusan.SetFocus
End If
End Sub

selamat mencoba ,,,,.... (' _'). good luck.

0 komentar: