\

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 [Link]
=
"SELECT
*
" &
"FROM anggota ORDER BY kdanggota"
[Link]
DataGridl. Refresh
With [Link]
If [Link] > 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
[Link] "kdanggota
=
'' &
_
kode & ""', ,
adSearchForward, 0
lf [Link]. 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 [Link]
=
If Typeof ctrl Is OptionButton Then Let
[Link] =
False
Flext ctrl
End Sub
Private Sub Aktifo
Dim ctrl As Control
For Each clrl In Me
If TypeOf ctrl Is TextBox Then
_
Let [Link]
=
True
If Type0f ctrl Is OptionButton Then
_
Let [Link]
=
True
lflext ctrl
End Sub
Private Sub NonAktifo
Dim ctrl As Control
For Each ctrl In Me
If TypeOf ctrl Is TextBox Then
_
Let [Link]
=
False
If TypeOf ctrl Is OptionButton Then Let
[Link]
=
False
Next ctrl
End Sub
Private Sub Tampilo
On Error Resume Next
With [Link]
Let txtKode,Text
=
.Fields(O)
Let [Link]
=
.Fields(1)
If .Fields(2)
=
"1" Then
Let [Link]
=
True
Else
Let [Link]
=
True
End If
Let [Link]
=
.Fields(3)
Let [Link]
=
.Fields(4)
Let [Link]
=
.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 [Link]
if mode
=
True Then .AddNew
Let .Fields(O)
=
[Link]
Let .Fields(1)
=
[Link]
If [Link] =
True Then
*
Let
'Fields(2) =
"1"
If [Link] =
True Then
-
Let .Fields(2)
= "Pu
Let .Fields(3)
=
[Link]
Let .Fields(4)
=
[Link]
Let .Fields(5)
=
[Link]
.Update
End With
llet mode
=
False
DataGrid 1. Refresh
Call NonAktif
MsgBox "Data berhasil disimpan."
Fxit Sub
ErrtfmdSimpan:
MsgBox "[Link] berhasil disimpan!"
End Sub
Private Sub cmdTambah-Click(
)
Let mode
=
True
Call Aktif
Call Bersih
Let [Link]
=
KodeOtomatis0
[Link]
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
[Link]
Let [Link]
=
False
Let mode
=
False
End If
End Sub
Private Sub Form_Loado
Let [Link]
=
"SELECT
*
FROM " &
"anggota ORDER BY kdanggota"
[Link]
Let [Link] =
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
[Link] =
"SELECT
*
FROM '&
"karyawan ORDER BY kdkaryawan"
i{dodc1. Refresh
DataGrid [Link]
With [Link]
If Adodcl,[Link] > 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,[Link] "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 [Link]
=
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 [Link]
=
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 [Link] =
False
Next ctrl
End Sub
Private Sub Tampilo
On Error Resume Next
With [Link]
Let [Link] =
.Fields(0)
Let [Link]
=
.Fields(1)
Let [Link]
=
.Fields(2)
Let [Link] =
.Fields(3)
Let [Link]
=
.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
[Link]
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:
[Link] 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
[Link]
[f Adodc 1. Recordset. EOF Then
MsgBox "Record terakhir." Let [Link]
=
False
Else Let [Link]
=
KodeOtomatisO
[Link] 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,[Link] Then Call Aktif
MsgBox "Record pertama."
Else Let [Link] =
False
[Link] Let mode
=
False
CallTampil End Sub
End If
End Sub Private Sub Form-Loado
Let [Link]
=
"SELECT
*
FROM' &
Pr$vate Sub cmdSimpan-ClickO " karyawan ORDER BY kdanggota"
On Error GoTo ErrCmdSimpan Let [Link]
=
False
Let [Link]
=
"*"
[f [Link] <> [Link] Then Let [Link]
= "*"
MsgBox "Password yang Anda ketikan tidak Let [Link]
=
False
sesuai l "
Exit Sub [Link] "ADMIN"
End If [Link] "KASIR"
With [Link] Call Tampil
If mode
=
True Then .AddNew Call NonAktif
End Sub
Let .Fields(O)
=
[Link]
Let .Fields(1)
=
[Link] Private Sub Form_Unload(Cancel As fnteger)
Let ,Fields(2) = [Link] 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 [Link] !
-\
Kode Program [Link]
Put:lic KodeKasir As String
Form Penyewaan dan Pengembalian
: : : : : : : : : : ; : : : : : : : i L i .t*anlterdekatrln- [Link]'Ssd ; : : : : ; : : : : : : : : : : : ,
DdaSewa----
Kode Program Form Penyewaan dan Pengembalian
Din:r total, subtotal As Currency
Private Sub SiapkanDatabaseo
Let [Link]
=
''SELECT
*
FROM
ser',va ORDER BY nosewa"
j-et
AdoDetsewa,RecrrrdSource
=
"SELECT
*
FROM
d,elail_sewa WHERE nosewa
=
"' & [Link] &
Let [Link]
=
"SELECT
x
FROM
mobil WHERE nopolisi NOT IN (SELECT nopolisi FROM
deLail_sewa WHERE status
=
'S')"
.et [Link] = 'SELECT
*
FROM
anggota ORDER BY kdanggota"
lAdoSewa. Refresh
AdoDetSewa. Refresh
AdoMobil. Refresh
,AdoAnggota . Refresh
End Sub
Private Sub IsiComboo
;On
Error GoTo ErrlsiCombo
[Link]
,AdoMobil. Refresh
With AdoMobil, Recordset
. MoveFirst
While Not .EOF
[Link] . Fields(0).Value
Nc. Sewa
No Polei h4ul,*
Selesai
t
. MoveNext
V/end
End With
ErrlsiCombo:
End Sub
Private Sub Aktifo
Let [Link]
=
True
Let [Link]
=
True
Let [Link]
=
True
Let [Link]
=
True
Let [Link]
=
True
Let [Link]
=
True
Let [Link]
=
True
End Sub
Private Sub NonAktifo
Let [Link]
=
False
Let [Link]
=
False
Let [Link]
=
False
Let [Link] =
False
Let [Link]
=
False
Let [Link]
=
False
Let [Link]
=
False
Let [Link]
=
False
Let [Link]
=
False
End Sub
f Fenprrhafian
$ub TotdBp.
Iddflp
i
lrans*si
I
i
t,--.--,.-
r----.-_----Z-:
Iextl
IextZ
Private Sub Bersiho
ilet [Link]
=
False
[-et [Link]
=
False
fi-et [Link]
=
""
llet [Link] =
""
ilet [Link] =
""
{-et [Link] =
""
End Sub
Prlvate Sub HitungSubTotalo
Dim lama As Integer
t-et lama
=
[Link] - [Link]
l-et subtotal
=
lama
*
[Link]
(2),
tlet [Link] =
Format(subtotal, " #,# # #.OO")
End Sub
Function KodeOtomatisO As String
Dim urut As Byte
With AdoSewa. Recordset
[Link]>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 =
[Link]
Let .Fields(1),Value
=
[Link]
Let .Fields(2).Value
=
KodeKasir
. Update
End With
Call Bersih
Call NonAktif
lLet AdoDetSewa,Recordsource =
"SELECT
*
FROM
detrail_sewa WHERE nosewa
=
"' & [Link] &
AdoDetSewa. Refresh
End Sub
Prlqrate Sub cmdTambah_Click(
)
l-et txtKdAnggota,Enabled = False
llet [Link] = "SELECT
x
FRoM
debail_sewa WHERE nopolisi
=
"' & [Link] & "'
AND status
=
'S"'
[Link]
Ef [Link] > 0 Then
MsgBox "Mobil sudah disewa! Silahkan pilih
mohil lain!"
Let [Link] = "SELECT
*
FROM detail_sewa WHERE nosewa
=
"' &
[Link] & ""'
AdoDetSewa, Refresh
Exit Sub
End If
Let AdoDetSewa,RecordSource
= "SELECT
x
FROM
detail_sewa WHERE nosewa
= "' & [Link] &
[Link]
AdoDetSewa. Recordset. Requery
With AdoDetSewa. Recordset
.AddNew
. Fields(0).Value
=
[Link]
.Fields(1).Value
= [Link]
.Fields(2).Value
=
[Link]
,Fields(3).Value
=
[Link]
.Fields(4),Value
=
"S"
,Update
End With
Let total
=
total + subtotal
Let [Link]
=
Format(total, " #,# # #.O0")
[Link]
End Sub
Private Sub cmdTransaksi_Click(
)
Call Bersih
Call NonAktif
Call IsiCombo
Let [Link]
=
True
Let [Link]
=
True
Let total
=
0
End Sub
Private Sub Combol_LostFocus(
)
AdoMobi L Recordset. MoveFi rst
[Link] "nopolisi
=
"' &
[Link] & ""',
, 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 [Link]
=
True
Let [Link]
=
""
Let [Link]
=
False
txtKdSewa . SetFocus
End Sub
Private Sub opSewa_Click(
)
Let [Link]
=
KodeOtomatis
Let [Link]
=
True
Let [Link]
=
False
txtKdAn g gota. SetFocus
End Sub
Private Sub txtKdAnggota_KeyPress(KeyAscii
As Integer)
If KeyAscii
=
13 Then
[Link]
=
"SELECT
kdanggota FROM anggota WHERE kdanggota
= "'& Exit Sub
[Link] & ""' End If
[Link]
With AdoSewa. Recordset
If [Link] > 0 Then .MoveFirst
Let [Link]
=
True .Find "nosewa
= "' & [Link] & ""',
,
Let [Link]
=
True adSearchForward, 0
Let [Link]
=
True Let [Link]
=
.Fields(1).Value
[Link] End With
Else
Let [Link]
=
False With [Link]
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 [Link]
=
"SELECT
*'{
MsgBox "Terima kasihl"
FROM detail sewa WHERE nosewa
=
"'&
[Link] & "' AND status
=
'S"' Call Bersih
[Link] Call NonAktif
If [Link]
=
0 Let [Link]
=
'SELECT
*
Then FROM detail_sewa WHERE nosewa
=
"' &
MsgBox "Tidak ada penyewaan dengan txtKdSewa.T
nornor" &[Link] &"!" [Link]
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.