“Penyewaan Bus Travel” dengan Visual Basic 6.0
Percontohan “Penyewaan Bus Travel” yang terdapat pada blog “Adam Khamarullah”.
Sedikit modifikasi yang dibuat, Dengan menambahkan Lama Peminjaman yang semula berdasarkan jam, disini berdasarkan Hari, Minggu, Bulan dan Tahun. Ditambahkan pula Tanggal Berangkat dan Kembali. Untuk lebih lengkapnya dapat dilihat pada kode sumber yang disertakan.
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "MSCOMCTL.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Travel Masa Kini"
ClientHeight = 6510
ClientLeft = 45
ClientTop = 405
ClientWidth = 10590
BeginProperty Font
Name = "Segoe UI"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6510
ScaleWidth = 10590
StartUpPosition = 2 'CenterScreen
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 31
Top = 6135
Visible = 0 'False
Width = 10590
_ExtentX = 18680
_ExtentY = 661
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 495
Index = 0
Left = 2040
TabIndex = 14
Top = 3900
Width = 3135
_ExtentX = 5530
_ExtentY = 873
_Version = 393216
Format = 20774912
CurrentDate = 41929
End
Begin VB.ComboBox Combo1
Height = 435
Index = 1
Left = 2040
TabIndex = 12
Text = "Combo1"
Top = 3360
Width = 3135
End
Begin VB.ComboBox Combo1
Height = 435
Index = 0
Left = 2040
TabIndex = 11
Text = "Combo1"
Top = 2880
Width = 3135
End
Begin VB.CommandButton Command1
Caption = "Keluar"
Height = 495
Index = 1
Left = 8520
TabIndex = 30
Top = 5880
Width = 1815
End
Begin VB.CommandButton Command1
Caption = "Proses"
Enabled = 0 'False
Height = 615
Index = 0
Left = 5520
TabIndex = 29
Top = 4200
Width = 4815
End
Begin VB.TextBox Text1
Height = 495
Index = 8
Left = 7215
Locked = -1 'True
TabIndex = 28
TabStop = 0 'False
Top = 3600
Width = 3135
End
Begin VB.TextBox Text1
Height = 495
Index = 7
Left = 7215
TabIndex = 26
Top = 3000
Width = 3135
End
Begin VB.TextBox Text1
Height = 495
Index = 6
Left = 7215
Locked = -1 'True
TabIndex = 24
TabStop = 0 'False
Top = 2400
Width = 3135
End
Begin VB.TextBox Text1
Height = 495
Index = 5
Left = 7215
Locked = -1 'True
TabIndex = 22
TabStop = 0 'False
Top = 1680
Width = 3135
End
Begin VB.TextBox Text1
Height = 495
Index = 4
Left = 7215
Locked = -1 'True
TabIndex = 20
TabStop = 0 'False
Top = 1080
Width = 3135
End
Begin VB.TextBox Text1
Height = 495
Index = 3
Left = 2055
Locked = -1 'True
TabIndex = 18
TabStop = 0 'False
Top = 5080
Width = 3135
End
Begin VB.TextBox Text1
Height = 495
Index = 2
Left = 2040
TabIndex = 9
Top = 2280
Width = 3135
End
Begin VB.TextBox Text1
Height = 495
Index = 1
Left = 2040
TabIndex = 7
Top = 1680
Width = 3135
End
Begin VB.TextBox Text1
Height = 495
Index = 0
Left = 2040
MaxLength = 9
TabIndex = 5
Top = 1080
Width = 3135
End
Begin VB.Timer Timer1
Interval = 1000
Left = 9840
Top = 240
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 495
Index = 1
Left = 2040
TabIndex = 16
Top = 4485
Width = 3135
_ExtentX = 5530
_ExtentY = 873
_Version = 393216
Format = 20774912
CurrentDate = 41929
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Kembali:"
Height = 315
Index = 15
Left = 945
TabIndex = 15
Top = 4560
Width = 900
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Berangkat:"
Height = 315
Index = 14
Left = 660
TabIndex = 13
Top = 3960
Width = 1110
End
Begin VB.Line Line1
Index = 0
X1 = 0
X2 = 10560
Y1 = 5760
Y2 = 5760
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Uang Kembali:"
Height = 315
Index = 13
Left = 5520
TabIndex = 27
Top = 3600
Width = 1500
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Pembayaran:"
Height = 315
Index = 12
Left = 5640
TabIndex = 25
Top = 3060
Width = 1350
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Total Bayar:"
Height = 315
Index = 11
Left = 5760
TabIndex = 23
Top = 2475
Width = 1200
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "PPn:"
Height = 315
Index = 10
Left = 6525
TabIndex = 21
Top = 1755
Width = 450
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Potongan:"
Height = 315
Index = 9
Left = 5940
TabIndex = 19
Top = 1155
Width = 1050
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Total Sewa:"
Height = 315
Index = 8
Left = 645
TabIndex = 17
Top = 5120
Width = 1170
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Biaya Sewa:"
Height = 315
Index = 7
Left = 600
TabIndex = 8
Top = 2295
Width = 1230
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Lama Sewa:"
Height = 315
Index = 6
Left = 600
TabIndex = 10
Top = 2940
Width = 1230
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Merk Kendaraan:"
Height = 315
Index = 5
Left = 105
TabIndex = 6
Top = 1740
Width = 1770
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Nomor Polisi:"
Height = 315
Index = 4
Left = 405
TabIndex = 4
Top = 1140
Width = 1410
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Jam"
Height = 375
Index = 3
Left = 7800
TabIndex = 3
Top = 405
Width = 2580
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Tanggal"
Height = 375
Index = 2
Left = 7800
TabIndex = 2
Top = 75
Width = 2580
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "PT. RAYA TRAVEL"
BeginProperty Font
Name = "Segoe UI"
Size = 26.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF8080&
Height = 705
Index = 1
Left = 240
TabIndex = 1
Top = 0
Width = 4425
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "PT. RAYA TRAVEL"
BeginProperty Font
Name = "Segoe UI"
Size = 26.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 705
Index = 0
Left = 280
TabIndex = 0
Top = 0
Width = 4425
End
Begin VB.Shape Shape1
BackStyle = 1 'Opaque
Height = 975
Left = -240
Top = -120
Width = 10935
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
BorderWidth = 4
Index = 1
X1 = 0
X2 = 10560
Y1 = 5760
Y2 = 5760
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim BiayaSewa, TotalBayar As Currency
Dim i%
Private Sub Combo1_Click(Index As Integer)
Select Case Index
Case 0:
If Combo1(0).ListIndex = 0 Then
Combo1(1).Clear
Combo1(1).Text = "--- Pilih ---"
For i = 1 To 6
Combo1(1).AddItem i
Next
ElseIf Combo1(Index).ListIndex = 1 Then
Combo1(1).Clear
Combo1(1).Text = "--- Pilih ---"
For i = 1 To 3
Combo1(1).AddItem i
Next
ElseIf Combo1(Index).ListIndex = 2 Or Combo1(Index).ListIndex = 3 Then
Combo1(1).Clear
Combo1(1).Text = "--- Pilih ---"
For i = 1 To 12
Combo1(1).AddItem i
Next
End If
End Select
End Sub
Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0:
If Command1(Index).Caption = "Proses" Then
Dim Pembayaran$
Pembayaran = Val(Text1(7).Text)
Text1(7).Text = Format(Pembayaran, "Currency")
Text1(8).Text = Format(Pembayaran - TotalBayar, "Currency")
Command1(Index).SetFocus
Command1(Index).Caption = "Transaksi Baru"
Else
For i = 0 To 8
Text1(i).Text = Empty
Next
For i = 0 To 1
Combo1(i).Clear
DTPicker1(i).Value = Now
Next
Form_Load
Command1(Index).Caption = "Proses"
Text1(0).SetFocus
End If
Case 1:
Unload Me
End Select
End Sub
Private Sub DTPicker1_Change(Index As Integer)
Dim Hari, Minggu, Bulan, Tahun As Integer
Dim TotalSewa, Potongan, PPn As Currency
Select Case Index
Case 0:
If Combo1(Index).ListIndex = 0 Then
Hari = Val(Combo1(1).Text)
DTPicker1(1).Value = DTPicker1(Index).Value + Val(Combo1(1).Text)
TotalSewa = BiayaSewa * Hari
ElseIf Combo1(Index).ListIndex = 1 Then
Minggu = Val(Combo1(1).Text) * 7
DTPicker1(1).Value = DTPicker1(Index).Value + Minggu
TotalSewa = BiayaSewa * Minggu
ElseIf Combo1(Index).ListIndex = 2 Then
Bulan = Val(Combo1(1).Text) * 30
DTPicker1(1).Value = DTPicker1(Index).Value + Bulan
TotalSewa = BiayaSewa * Bulan
ElseIf Combo1(Index).ListIndex = 3 Then
Tahun = Val(Combo1(1).Text) * 360
DTPicker1(1).Value = DTPicker1(Index).Value + Tahun
TotalSewa = BiayaSewa * Tahun
End If
Potongan = 0.1 * TotalSewa
PPn = 0.5 * TotalSewa
TotalBayar = (TotalSewa - Potongan) + PPn
Text1(3).Text = Format(TotalSewa, "Currency")
Text1(4).Text = Format(Potongan, "Currency")
Text1(5).Text = Format(PPn, "Currency")
Text1(6).Text = Format(TotalBayar, "Currency")
Text1(7).SetFocus
End Select
End Sub
Private Sub Form_Load()
With Combo1(0)
.Text = "--- Pilih ---"
.AddItem "Hari"
.AddItem "Minggu"
.AddItem "Bulan"
.AddItem "Tahun"
End With
Combo1(1).Text = "--- Pilih ---"
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MsgBox("Keluar program ?", vbQuestion + vbYesNo, "Perhatian") = vbNo Then
Cancel = 1
Text1(0).SetFocus
End If
End Sub
Private Sub Text1_Change(Index As Integer)
Select Case Index
Case 1:
Dim Masukan%
Masukan = Text1(Index).SelStart
Text1(Index).Text = StrConv(Text1(Index).Text, vbProperCase)
Text1(Index).SelStart = Masukan
Case 7:
If Len(Text1(Index).Text) > 0 Then
Command1(0).Enabled = True
Else
Command1(0).Enabled = False
End If
End Select
End Sub
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
Dim Karakter$
Karakter = "~`!@#$%^&*()-_+=[]{}:;'<>,.?/\|"
Select Case Index
Case 0:
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If InStr(1, Karakter, Chr(KeyAscii)) > 0 Then
Beep
KeyAscii = 0
ElseIf (KeyAscii = 13) Then
SendKeys "{tab}"
KeyAscii = 0
End If
Case 1:
If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Then
Beep
KeyAscii = 0
ElseIf InStr(1, Karakter, Chr(KeyAscii)) > 0 Then
Beep
KeyAscii = 0
ElseIf (KeyAscii = 13) Then
SendKeys "{tab}"
KeyAscii = 0
End If
Case 2:
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = 13 Or KeyAscii = vbKeyBack) Then
Beep
KeyAscii = 0
ElseIf (KeyAscii = 13) Then
SendKeys "{tab}"
KeyAscii = 0
BiayaSewa = Val(Text1(2).Text)
Text1(2).Text = Format(BiayaSewa, "Currency")
End If
Case 7:
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = 13 Or KeyAscii = vbKeyBack) Then
Beep
KeyAscii = 0
ElseIf (KeyAscii = 13) Then
Command1_Click (0)
End If
End Select
End Sub
Private Sub Timer1_Timer()
Label1(2).Caption = Format(Now, "dddd, d mmmm yyyy")
Label1(3).Caption = TimeValue(Format(Now, "hh:mm:ss"))
End Sub
Unduh Kode Sumber.
Label: VB6
diposting oleh Guntur Nitiputra @ 01.15.00
0 Komentar
0 Komentar:
Posting Komentar
Berlangganan Posting Komentar [Atom]
<< Beranda