0% found this document useful (0 votes)
343 views8 pages

Tutorial Visual Basic 6 - Database MySQL Dan ADODC

Contoh program koneksi database MySQL dengan Visual Basic 6.0 menggunakan ADODC. Contoh kasus penyewaan mobil.
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd
0% found this document useful (0 votes)
343 views8 pages

Tutorial Visual Basic 6 - Database MySQL Dan ADODC

Contoh program koneksi database MySQL dengan Visual Basic 6.0 menggunakan ADODC. Contoh kasus penyewaan mobil.
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd
You are on page 1/ 8

\

Pemrograman Visual ll- Studi Kasus Penyewaan Mobil


-
Kresna Adhi Pratama i PYK
Dadabase: PENYEWAANMOBIL
Struktur Tabel
1. Tabel: anggota
Field Type Width
kdanggota CHAR 5
nmanggota VARCHAR 25
gender CHAR 1
alamat VARCHAR 30
telepon VARCHAR 15
noktp VARCHAR 20
2. Tabel. karyawan
Field Type Width
kdkaryawan CHAR 5
nmkaryawan VARCHAR 25
jabatan
VARCHAR 5
password VARCHAR 15
Tabel:mobil
Field Type
nopolisi VARCHAR
nmmobil VARCHAR
tarif MEDIUMINT
Tabel:sewa
Field Type
nosewa CHAR
kdanggota CHAR
kdkaryawan CHAR
Tabel: detailsewa
Field Type
nosewa CHAR
nopolisi VARCHAR
tglsewa DATE
tglkembali DATE
status CHAR
Primary
Yes
3.
4.
5.
width
8
25
10
width
9
5
5
width
I
8
't
Primary
Yes
Primary
Yes
Primary
Primary
Yes
Form Master Anggota
Kode Program Form Master Anggota
Dinn mode As Boolean
Function KodeOtomatisO As String
Dim urut As Integer
liet Adodcl.RecordSource
=
"SELECT
*
" &
"FROM anggota ORDER BY kdanggota"
Adodcl.Refresh
DataGridl. Refresh
With Adodcl.Recordset
If Adodcl.Recordset.RecordCount > 0 Then
.Movelast
Let urut
=
Val(Right(.Fields(O), 4)) + 1
Else
Let urut
=
I
End If
Let KodeOtomatis
=
"A" +
_
Format(urut, "0000')
End With
End Function
Function Cari(kode As String) As Boolean
Let Cari
=
False
Adodcl. Recordset. MoveFi rst
Adodcl.Recordset.Find "kdanggota
=
'' &
_
kode & ""', ,
adSearchForward, 0
lf Adodcl.Recordset. EOF Then
Let Cari
=
False
Else
Let Cari =
True
End If
End Function
Private Sub Bersiho
Dim ctrl As Control
For Each ctrl In Me
,,,,tf
ttpuOf ctrl Is TextBox Then Let ctrl.Text
=
If Typeof ctrl Is OptionButton Then Let
ctrl.Value =
False
Flext ctrl
End Sub
Private Sub Aktifo
Dim ctrl As Control
For Each clrl In Me
If TypeOf ctrl Is TextBox Then
_
Let ctrl.Enabled
=
True
If Type0f ctrl Is OptionButton Then
_
Let ctrl.Enabled
=
True
lflext ctrl
End Sub
Private Sub NonAktifo
Dim ctrl As Control
For Each ctrl In Me
If TypeOf ctrl Is TextBox Then
_
Let ctrl.Enabled
=
False
If TypeOf ctrl Is OptionButton Then Let
ctrl.Enabled
=
False
Next ctrl
End Sub
Private Sub Tampilo
On Error Resume Next
With Adodcl.Recordset
Let txtKode,Text
=
.Fields(O)
Let txtNama.Text
=
.Fields(1)
If .Fields(2)
=
"1" Then
Let OpLaki.Value
=
True
Else
Let OpPerempuan.Value
=
True
End If
Let txtAlamat.Text
=
.Fields(3)
Let txtTelepon.Text
=
.Fields(4)
Let txtKtp.Text
=
.Fields(5)
End With
End Sub
Private Sub cmdBatal_Click(
)
CallTampil
Call NonAktif
Let mode
=
False
End Sub
Private Sub cmdHapus_Clicko
On Error GoTo ErrCmdHapus
Dim kode As String
Dim ada, tanya As Byte
Let kode
=
InputBox("Ketikan kode anggota:",
"Hapus Anggota", "")
If Trim(kode)
= "" Then Exit Sub
Let ada = Cari(kode)
If ada
=
True Then
Let tanya = MsgBox("Hapus data?", vbYesNo,
"Konfirmasi")
If tanya
=
vbYes Then
Adodc 1 . Recordset. Delete
MsgBox "Data telah dihapus."
Call Bersih
CallTampil
End If
Else
MsgBox "Data tidak adal", "Hapus Anggota"
End If
Exit Sub
ErrCmdHapus:
MsgBox "Data gagal dihapus!"
End Sub
Private Sub cmdKeluar_Clicko
Unload Me
End Suh
Private Sub cmdSimpan_Click(
)
\
On Error GoTo ErrCmdSimpan
With Adodcl.Recordset
if mode
=
True Then .AddNew
Let .Fields(O)
=
txtKode.Text
Let .Fields(1)
=
txtNama.Text
If Oplaki.Value =
True Then
*
Let
'Fields(2) =
"1"
If OpPerempuan.Value =
True Then
-
Let .Fields(2)
= "Pu
Let .Fields(3)
=
txtAlamat.Text
Let .Fields(4)
=
txtTelepon.Text
Let .Fields(5)
=
txtKtp.Text
.Update
End With
llet mode
=
False
DataGrid 1. Refresh
Call NonAktif
MsgBox "Data berhasil disimpan."
Fxit Sub
ErrtfmdSimpan:
MsgBox "Data.tidak berhasil disimpan!"
End Sub
Private Sub cmdTambah-Click(
)
Let mode
=
True
Call Aktif
Call Bersih
Let txtKode.Text
=
KodeOtomatis0
t-xtNama.SetFocus
End Sub
Private Sub cmdUbah-Clicko
Dim ada As Boolean
Dim kode As String
Let kode
=
InputBox("Ketikan kode anggota:",
_
"Ubah Anggota")
If Trim(kode)
=
"" Then Exit Sub
Let ada
= Cari(kode)
If ada
=
False Then
MsgBox "Data tidak ditemukan!"
Else
Call Aktif
CallTampil
txtNama.SetFocus
Let txtKode.Enabled
=
False
Let mode
=
False
End If
End Sub
Private Sub Form_Loado
Let Adodcl.RecordSource
=
"SELECT
*
FROM " &
"anggota ORDER BY kdanggota"
Adodcl.Refresh
Let Adodcl.Visible =
False
DataGrid 1 , Refresh
Call Bersih
Call Tampil
Call NonAktif
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim tanya As Byte
Let tanya
=
MsgBox("Tutup program?",
_
vbYesNo, "Konfirmasi")
If tanya
=
vbNo Then Let Cancel
=
-1
End Sub
Form Master Karyawan
'ttt
:
xl.<iirlrt
Kode Program Form Master Karyawan
\
Dirn mode As Boolean
Function KodeOtomatisO As String
Dim urut As Integer
Adodcl.RecordSource =
"SELECT
*
FROM '&
"karyawan ORDER BY kdkaryawan"
i{dodc1. Refresh
DataGrid l.Refresh
With Adodcl.Recordset
If Adodcl,Recordset.RecordCount > 0 Then
.MoveLast
Let urut
=
Val(Right(.Fields(0), 4)) + 1
Else
Let urut
=
1
End If
Let KodeOtomatis
=
"K" +
-
Format(urut, '0000")
Fnd With
End Function
Fuerction Cari(kode As String) As Boolean
Let Cari =
False
,Adodc1. Recordset. MoveFirst
Adodcl,Recordset.Find "kdkaryawan
=
'" &
-
kode & ""', ,
adSearchForward, 0
lf Adodcl. Recordset. EOF Then
Let Cari =
False
Else
Let Cari =
True
End If
End Function
Pri\rate Sub Bersiho
Dim ctrl As Control
lFor Each ctrl In Me
If TypeOf ctrl Is TextBox Or
-
Type0f ctrl Is ComboBox Then ctrl.Text
=
Flext ctrl
End Sub
Priqrate Sub Aktifo
Dim ctrl As Control
For Each ctrl In Me
If TypeOf ctrl Is TextBox Or
-
TypeOf ctrl Is ComboBox Then
-
Let ctrl.Enabled
=
True
lNext ctrl
End Sub
Private Sub NonAlGifo
Dim ctrl As Control
For Each ctrl In Me
If Type0f ctrl Is TextBox Or
-
Typeof ctrl Is ComboBox Then
-
Let ctrl.Enabled =
False
Next ctrl
End Sub
Private Sub Tampilo
On Error Resume Next
With Adodcl.Recordset
Let txtKode.Text =
.Fields(0)
Let txtNama.Text
=
.Fields(1)
Let cmblabatan.Text
=
.Fields(2)
Let txtPassword.Text =
.Fields(3)
Let txtKonfirmasi.Text
=
.Fields(3)
End With
End Sub
Private Sub cmdBatal_Clicko
CallTampil
Call NonAktif
Let mode
=
False
End Sub
Private Sub cmdCari-Clicko
On Error GoTo ErrCmdCari
Dim kode As String
Dim ada As Boolean
Let kode =
InputBox("Ketikan kode karyawan:",
-
"Cari Data Karyawan", "")
If Trim(kode)
=
"" Then Exit Sub
Let ada = Cari(kode)
If ada =
False Then
MsgBox "Data tidak ada!"
Else
CallTampil
End If
Exit Sub
ErrCmdCari:
MsgBox "Pencarian tidak bisa dilakukanl"
End Sub
Private Sub cmdFirst-Click(
)
On Error Resume Next
Adodcl . Recordset. MoveFirst
CallTampil
End Sub
Private Sub cmdHapus_Click(
)
On Error GoTo ErrCmdHapus
Dim tanya As Byte
Let tanya
=
MsgBox("Hapus data?", vbYesNo,
_
"Hapus Karyawan")
If tanya
=
vbYes Then
Adodcl. Recordset. Delete
Adodcl.Refresh
CallTampil
MsgBox "Data berhasil dihapus."
End If
Exit Sub
ErrCmdHapus:
MsgBox "Data gagal dihapusl"
End Sub
MsgBox "Data berhasil disimpan,"
Prtvate Sub cmdlast-ClickO , Exit Sub
tCn Error Resume Next
ErrCmdSimpan:
Adodcl.Recordset.MoveLast MsgBox "Data tidak berhasil disimpanl"
CallTampil End Sub
End Sub
Private Sub cmdTambah_Clicko
Prlvate Sub cmdNext_ClickO
'
Call Bersih
On Error Resume Next Call Aktif
txtNama.SetFocus
[f Adodc 1. Recordset. EOF Then
MsgBox "Record terakhir." Let txtKode.Enabled
=
False
Else Let txtKode.Text
=
KodeOtomatisO
Adodcl.Recordset.MoveNext Let mode
=
True
Call Tampil
'
End Sub
End If
End Sub
I Private Sub cmdTutup_Clicko
Unload Me
Prfrvate Sub cmdPrev-ClickO End Sub
0n Error Resume Next
Private Sub cmdUbah_Click(
)
Sf Adodcl,Recordset.BOF Then Call Aktif
MsgBox "Record pertama."
Else Let txtKode.Enabled =
False
Adodcl.Recordset.MovePrevious Let mode
=
False
CallTampil End Sub
End If
End Sub Private Sub Form-Loado
Let Adodcl.RecordSource
=
"SELECT
*
FROM' &
Pr$vate Sub cmdSimpan-ClickO " karyawan ORDER BY kdanggota"
On Error GoTo ErrCmdSimpan Let Adodcl.Visible
=
False
Let txtPassword.PasswordChar
=
"*"
[f txtPassword.Text <> txtKonfirmasi.Text Then Let txtKonfirmasi.PasswordChar
= "*"
MsgBox "Password yang Anda ketikan tidak Let DataGridl.Visible
=
False
sesuai l "
Exit Sub cmblabatan.Addltem "ADMIN"
End If cmblabatan.Addltem "KASIR"
With Adodcl.Recordset Call Tampil
If mode
=
True Then .AddNew Call NonAktif
End Sub
Let .Fields(O)
=
txtKode.Text
Let .Fields(1)
=
txtNama.Text Private Sub Form_Unload(Cancel As fnteger)
Let ,Fields(2) = cmblabatan.Text Dim tanya As Byte
Let .Fields(3)
=
txtPassword,Text
Let tanya
=
MsgBox("Tutup program?",
_
.Update vbYesNo, "Konfirmasi")
End With
If tanya
=
vbNo Then Let Cancel
=
-1
Call NonAktif End Sub
$-et mode
=
False
Buatlah sebuah moduldengan nama file Modull.bas !
-\
Kode Program Modull.bas
Put:lic KodeKasir As String
Form Penyewaan dan Pengembalian
: : : : : : : : : : ; : : : : : : : i L i .t*anlterdekatrln- ig8-BooryTdeoontl2nl.ets'Ssd ; : : : : ; : : : : : : : : : : : ,
DdaSewa----
Kode Program Form Penyewaan dan Pengembalian
Din:r total, subtotal As Currency
Private Sub SiapkanDatabaseo
Let AdoSewa.RecordSource
=
''SELECT
*
FROM
ser',va ORDER BY nosewa"
j-et
AdoDetsewa,RecrrrdSource
=
"SELECT
*
FROM
d,elail_sewa WHERE nosewa
=
"' & txtKdSewa.Text &
Let AdoMobil.RecordSource
=
"SELECT
x
FROM
mobil WHERE nopolisi NOT IN (SELECT nopolisi FROM
deLail_sewa WHERE status
=
'S')"
.et AdoAnggota.Recordsource = 'SELECT
*
FROM
anggota ORDER BY kdanggota"
lAdoSewa. Refresh
AdoDetSewa. Refresh
AdoMobil. Refresh
,AdoAnggota . Refresh
End Sub
Private Sub IsiComboo
;On
Error GoTo ErrlsiCombo
Combol.Clear
,AdoMobil. Refresh
With AdoMobil, Recordset
. MoveFirst
While Not .EOF
Combol.AddItem . Fields(0).Value
Nc. Sewa
No Polei h4ul,*
Selesai
t
. MoveNext
V/end
End With
ErrlsiCombo:
End Sub
Private Sub Aktifo
Let txtSub.Enabled
=
True
Let txtTotal.Enabled
=
True
Let txtKdSewa.Enabled
=
True
Let txtKdAnggota.Enabled
=
True
Let DataCombol.Enabled
=
True
Let DTPMulai.Enabled
=
True
Let DTPSelesai.Enabled
=
True
End Sub
Private Sub NonAktifo
Let opSewa.Enabled
=
False
Let opKembali.Enabled
=
False
Let txtSub.Enabled
=
False
Let txtTotal.Enabled =
False
Let txtKdSewa.Enabled
=
False
Let txtKdAnggota.Enabled
=
False
Let Combol.Enabled
=
False
Let DTPMulai.Enabled
=
False
Let DTPSelesai.Enabled
=
False
End Sub
f Fenprrhafian
$ub TotdBp.
Iddflp
i
lrans*si
I
i
t,--.--,.-
r----.-_----Z-:
Iextl
IextZ
Private Sub Bersiho
ilet opSewa.Value
=
False
[-et opKembali.Value
=
False
fi-et txtsub.Text
=
""
llet txtTotal.Text =
""
ilet txtKdSewa.Text =
""
{-et txtKdAnggota.Text =
""
End Sub
Prlvate Sub HitungSubTotalo
Dim lama As Integer
t-et lama
=
DTPSelesai.Value - DTPMulai.Value
l-et subtotal
=
lama
*
AdoMobil.Recordset.Fields
(2),
tlet txtSub.Text =
Format(subtotal, " #,# # #.OO")
End Sub
Function KodeOtomatisO As String
Dim urut As Byte
With AdoSewa. Recordset
If.RecordCount>0Then
.MoveLast
Let urut
=
Val(Right(.Fields(O), 3)) + 1
Else
Let urut
=
1
End If
Fnd With
t-et KodeOtomatis
=
Format(Now, "yyMMdd") &
Forrnat(urut, "000")
End Function
Prtoate Sub cmdSelesai_Clicko
With AdoSewa. Recordset
.AddNew
Let .Fields(0),Value =
txtKdSewa.Text
Let .Fields(1),Value
=
txtKdAnggota.Text
Let .Fields(2).Value
=
KodeKasir
. Update
End With
Call Bersih
Call NonAktif
lLet AdoDetSewa,Recordsource =
"SELECT
*
FROM
detrail_sewa WHERE nosewa
=
"' & txtKdSewa.Text &
AdoDetSewa. Refresh
End Sub
Prlqrate Sub cmdTambah_Click(
)
l-et txtKdAnggota,Enabled = False
llet AdoDetSewa.RecordSource = "SELECT
x
FRoM
debail_sewa WHERE nopolisi
=
"' & Combol.Text & "'
AND status
=
'S"'
zAdoDetSewa.Refresh
Ef AdoDetSewa.Recordset.RecordCount > 0 Then
MsgBox "Mobil sudah disewa! Silahkan pilih
mohil lain!"
Let AdoDetSewa.RecordSource = "SELECT
*
FROM detail_sewa WHERE nosewa
=
"' &
txtKdSewa.Text & ""'
AdoDetSewa, Refresh
Exit Sub
End If
Let AdoDetSewa,RecordSource
= "SELECT
x
FROM
detail_sewa WHERE nosewa
= "' & txtKdSewa.Text &
AdoDetSewa.Refresh
AdoDetSewa. Recordset. Requery
With AdoDetSewa. Recordset
.AddNew
. Fields(0).Value
=
txtKdSewa.Text
.Fields(1).Value
= Combol.Text
.Fields(2).Value
=
DTPMulai.Value
,Fields(3).Value
=
DTPSelesai.Value
.Fields(4),Value
=
"S"
,Update
End With
Let total
=
total + subtotal
Let txtTotal.Text
=
Format(total, " #,# # #.O0")
DataGridl.Refresh
End Sub
Private Sub cmdTransaksi_Click(
)
Call Bersih
Call NonAktif
Call IsiCombo
Let opSewa.Enabled
=
True
Let opKembali.Enabled
=
True
Let total
=
0
End Sub
Private Sub Combol_LostFocus(
)
AdoMobi L Recordset. MoveFi rst
AdoMobil.Recordset.Find "nopolisi
=
"' &
Combol.Text & ""',
, adSearchForward, 0
Call HitungSubTotal
End Sub
Private Sub DTPSelesai_Changeo
Call HitungSubTotal
End Sub
Private Sub Form_Loado
Call NonAktif
Call SiapkanDatabase
End Sub
Private Sub opKembali_Clicko
Let txtKdSewa.Enabled
=
True
Let txtKdSewa.Text
=
""
Let opSewa.Enabled
=
False
txtKdSewa . SetFocus
End Sub
Private Sub opSewa_Click(
)
Let txtKdSewa.Text
=
KodeOtomatis
Let txtKdAnggota.Enabled
=
True
Let opKembali.Enabled
=
False
txtKdAn g gota. SetFocus
End Sub
Private Sub txtKdAnggota_KeyPress(KeyAscii
As Integer)
If KeyAscii
=
13 Then
AdoAnggota.RecordSource
=
"SELECT
kdanggota FROM anggota WHERE kdanggota
= "'& Exit Sub
txtKdAnggota.Text & ""' End If
AdoAnggota.Refresh
With AdoSewa. Recordset
If AdoAnggota.Recordset.RecordCount > 0 Then .MoveFirst
Let Combol.Enabled
=
True .Find "nosewa
= "' & txtKdSewa.Text & ""',
,
Let DTPMulai.Enabled
=
True adSearchForward, 0
Let DTPSelesai.Enabled
=
True Let txtKdAnggota.Text
=
.Fields(1).Value
Combol.SetFocus End With
Else
Let Combol.Enabled
=
False With AdoDetSewa.Recordset
MsgBox "Kode anggota tidak ada!" .MoveFirst
End If While .EOF
=
False
End If .Fields(4).Value
=
"K"
End Sub .Update
.MoveNext
Prlvate Sub txtKdSewa_KeyPress(KeyAscii As Wend
Integer) End With
Sf KeyAscii
=
13 Then
Let AdoDetSewa.RecordSource
=
"SELECT
*'{
MsgBox "Terima kasihl"
FROM detail sewa WHERE nosewa
=
"'&
txtKdSewa.Text & "' AND status
=
'S"' Call Bersih
AdoDetSewa.Refresh Call NonAktif
If AdoDetSewa.Recordset.RecordCount
=
0 Let AdoDetSewa.RecordSource
=
'SELECT
*
Then FROM detail_sewa WHERE nosewa
=
"' &
MsgBox "Tidak ada penyewaan dengan txtKdSewa.T
nornor" &txtKdSewa.Text &"!" AdoDetSewa.Refresh
Call Bersih End If
Call NonAktif End Sub
Ga*atan:
.
Hubungkan objek Text1, Text2 dan Text3 dengan properti AdoSewa, AdoMobil dan AdoAnggota.
.
Objek DBGridl menggunakan Datasource dariobjek AdoDetSewa.

You might also like