Kali ini penulis akan sedikit berbagi tentang pembuatan aplikasi penjualan pulsa menggunakan VB 6.0, seiring dengan perkembangan tekhnologi yang semakin pesat, Pulsa pun menjadi kebutuhan yang primer bagi sebagian masyarakat di indonesia... berangkat dari hal itu, ketika saya membeli pulsa elektrik disalah satu Counter di Tangerang, mereka menyediakan Buku tamu/Catatan No Handphone, kemudian saya berfikir untuk memudahkan pencatatan nomor Hp dengan sebuah aplikasi Visual Basic 6.0... Berikut contoh programnya
Untuk List Programnya bisa lihat di bawah Ini
1. Form Utama/Pulsa
Public char As String
Public v, i As Integer
Private Sub Cmdbersihvoucher_Click()
If MsgBox("Yakin Mo Keluar Dari Aplikasi Zul Cellular Y/N...!!!", vbOKCancel + vbQuestion, "Warning") = vbOK Then
frmexit.Show
Unload Me
End If
End Sub
Private Sub Cmdhapusvoucher_Click()
If MsgBox("Yakin Data Mo Di Delete...", vbOKCancel + vbQuestion, "Pesan") = vbOK Then
db.Execute "delete from ZulCellular where No_Handphone='" & txtno.Text & "'"
End If
rs.MovePrevious
rs.Requery
tampil
End Sub
Private Sub Cmdperbaikivoucher_Click()
rs!Kode = txtkode
rs!No_Handphone = txtno.Text
rs!Jenis_Voucher = cbojenis
rs!Nominal = Txtnominal.Text
rs!Harga_Jual = Txtjual
rs!Sisa_Deposit = txtdeposit.Text
rs!Pembayaran = CBKet
rs!Tanggal = Label10
rs!Jam = Lbljam
rs.Update
kunci
MsgBox "Data Telah Di Edit", vbInformation, "Zul Cellular"
End Sub
Private Sub Cmdsimpanvoucher_Click()
On Error Resume Next
If MsgBox("Apakah Data Akan Disimpan [Y/T] ?", vbYesNo + vbQuestion, "Pesan Simpan") = vbYes Then
rs.AddNew
rs!Kode = txtkode
rs!No_Handphone = txtno.Text
rs!Jenis_Voucher = cbojenis
rs!Nominal = Txtnominal.Text
rs!Harga_Jual = Txtjual
rs!Sisa_Deposit = txtdeposit.Text
rs!Pembayaran = CBKet
rs!Tanggal = Label10
rs!Jam = Lbljam
rs.Update
Else
Exit Sub
End If
On Error GoTo 0
kunci
tampil
End Sub
Private Sub Command1_Click()
On Error Resume Next
rs.MovePrevious
If rs.BOF Then
MsgBox "Data Sudah Paling Awal....", vbInformation, "Zul Cellular"
rs.MoveFirst
End If
tampil
End Sub
Private Sub Command2_Click()
On Error Resume Next
rs.MoveNext
If rs.EOF Then
MsgBox "Data Dah Ujung....", vbInformation, "Zul Cellular"
rs.MoveFirst
End If
tampil
End Sub
Private Sub Command3_Click()
buka
kosong
Call Kode
txtkode.SetFocus
End Sub
Private Sub Form_Load()
konek
tampil
kunci
MsgBox "Welcome To Zul Cellular", vbInformation, "Zul Cellular"
With CBKet
.AddItem "Tunai"
.AddItem "Kredit"
End With
With cbojenis
.AddItem "Mentari"
.AddItem "IM3"
.AddItem "Starone"
.AddItem "Simpati"
.AddItem "AS"
.AddItem "XL"
.AddItem "Flexi"
.AddItem "Esia"
.AddItem "Fren"
.AddItem "Three"
.AddItem "Axis"
.AddItem "Hepi"
.AddItem "Smart"
End With
Me.Top = (Screen.Height - Height) / 2
Me.Left = (Screen.Width - Width) / 2
frmpulsa.Caption = " Data Penjualan Pulsa Firman "
char = Me.Caption
v = Len(char)
Label10 = Format(Date, "mm-dd-YYYY")
End Sub
Private Sub Image2_Click()
Call buka
End Sub
Private Sub Image3_Click()
On Error Resume Next
Set rs = New ADODB.Recordset
rs.Open "select * from ZulCellular", db, adOpenDynamic, adLockOptimistic
Set DataReport1.DataSource = rs
DataReport1.Sections("Detail").Controls("Text9").DataField = "Kode"
DataReport1.Sections("Detail").Controls("Text1").DataField = "No_Handphone"
DataReport1.Sections("Detail").Controls("Text2").DataField = "Jenis_Voucher"
DataReport1.Sections("Detail").Controls("Text3").DataField = "Nominal"
DataReport1.Sections("Detail").Controls("Text4").DataField = "Harga_Jual"
DataReport1.Sections("Detail").Controls("Text5").DataField = "Sisa_Deposit"
DataReport1.Sections("Detail").Controls("Text6").DataField = "Pembayaran"
DataReport1.Sections("Detail").Controls("Text7").DataField = "Tanggal"
DataReport1.Sections("Detail").Controls("Text8").DataField = "Jam"
DataReport1.Show
On Error GoTo 0
End Sub
Private Sub Image4_Click()
On Error Resume Next
Cari = InputBox("Masukin No Handphone")
rs.MoveFirst
rs.Find ("No_Handphone='" & Cari & "'")
tampil
salah:
If Err.Number = 3021 Then
MsgBox "data tidak ada"
End If
End Sub
Private Sub Timer1_Timer()
Me.Caption = Left$(char, i)
i = i + 1
If i = v Then
i = 0
End If
End Sub
Sub tampil()
txtkode.Text = rs!Kode
txtno.Text = rs!No_Handphone
cbojenis.Text = rs!Jenis_Voucher
Txtnominal.Text = rs!Nominal
Txtjual = rs!Harga_Jual
txtdeposit.Text = rs!Sisa_Deposit
CBKet = rs!Pembayaran
End Sub
Sub kosong()
txtkode.Text = Clear
txtno.Text = Clear
cbojenis = Clear
Txtnominal.Text = Clear
Txtjual = Clear
txtdeposit.Text = Clear
CBKet = Clear
End Sub
Sub kunci()
txtkode.Enabled = False
txtno.Enabled = False
cbojenis.Enabled = False
Txtnominal.Enabled = False
Txtjual.Enabled = False
txtdeposit.Enabled = False
CBKet.Enabled = False
End Sub
Sub buka()
txtkode.Enabled = True
txtno.Enabled = True
cbojenis.Enabled = True
Txtnominal.Enabled = True
Txtjual.Enabled = True
txtdeposit.Enabled = True
CBKet.Enabled = True
End Sub
Private Sub Timer2_Timer()
Lbljam.Caption = Format(Time, "HH:MM:SS")
End Sub
Sub Kode()
Dim Kode As Integer
If rs.RecordCount = 0 Then
txtkode.Text = "K0001"
Else
rs.MoveLast
Kode = Right(rs![Kode], 4) + 1
txtkode.Text = Format(Kode, "K0000")
End If
End Sub
Private Sub Txtnominal_Change()
Select Case Txtnominal
Case "1000"
Txtjual.Text = 1500
Case "2000"
Txtjual.Text = 4000
Case "3000"
Txtjual.Text = 5000
Case "4000"
Txtjual.Text = 6000
Case "5000"
Txtjual.Text = 7000
Case "6000"
Txtjual.Text = 8000
Case "7000"
Txtjual.Text = 9000
Case "8000"
Txtjual.Text = 10000
Case "9000"
Txtjual.Text = 11000
Case "10000"
Txtjual.Text = 12000
Case "11000"
Txtjual.Text = 13000
Case "12000"
Txtjual.Text = 14000
Case "13000"
Txtjual.Text = 15000
Case "14000"
Txtjual.Text = 16000
Case "15000"
Txtjual.Text = 17000
Case "20000"
Txtjual.Text = 22000
Case "25000"
Txtjual.Text = 27000
Case "30000"
Txtjual.Text = 32000
Case "50000"
Txtjual.Text = 52000
Case "100000"
Txtjual.Text = 102000
End Select
End Sub
2. List Coding Module
Global db As New ADODB.Connection
Global rs As New ADODB.Recordset
Public Sub konek()
Set db = New ADODB.Connection
db.Open "provider=microsoft.jet.oledb.4.0;data source=" & App.Path & "/Pulsa.mdb"
Set rs = New ADODB.Recordset
rs.Open "ZulCellular", db, 1, 2
End Sub
Sekian Dulu Yach Tipsnya
