“Penjualan Tiket Kereta” dengan Visual Basic 6.0
Contoh latihan Visual Basic 6.0 “Penjualan Tiket Kereta”.
Sedikit modifikasi yang dibuat, yaitu dengan menambahkan banyak penumpang dalam kategori Anak, Dewasa dan Lansia. Untuk lebih lengkapnya dapat dilihat pada kode sumber yang disertakan.
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Penjualan Tiket Kereta"
ClientHeight = 7710
ClientLeft = 45
ClientTop = 330
ClientWidth = 8910
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7710
ScaleWidth = 8910
StartUpPosition = 2 'CenterScreen
Begin VB.Frame Frame1
BeginProperty Font
Name = "Segoe UI"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 5055
Index = 3
Left = 4800
TabIndex = 24
Top = 960
Width = 3975
Begin VB.CommandButton Command1
Caption = "Proses"
Enabled = 0 'False
BeginProperty Font
Name = "Segoe UI"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 1
Left = 480
TabIndex = 37
Top = 3960
Width = 3135
End
Begin VB.TextBox Text1
Height = 375
Index = 12
Left = 1920
Locked = -1 'True
TabIndex = 36
TabStop = 0 'False
Top = 3240
Width = 1695
End
Begin VB.TextBox Text1
Height = 375
Index = 11
Left = 1920
TabIndex = 34
Top = 2640
Width = 1695
End
Begin VB.TextBox Text1
Height = 375
Index = 10
Left = 1920
Locked = -1 'True
TabIndex = 32
TabStop = 0 'False
Top = 1800
Width = 1695
End
Begin VB.TextBox Text1
Height = 375
Index = 9
Left = 1920
Locked = -1 'True
TabIndex = 30
TabStop = 0 'False
Top = 1320
Width = 1695
End
Begin VB.TextBox Text1
Height = 375
Index = 8
Left = 1920
Locked = -1 'True
TabIndex = 28
TabStop = 0 'False
Top = 840
Width = 1695
End
Begin VB.TextBox Text1
Height = 375
Index = 7
Left = 1920
Locked = -1 'True
TabIndex = 26
TabStop = 0 'False
Top = 360
Width = 1695
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Kembali:"
ForeColor = &H80000008&
Height = 300
Index = 14
Left = 720
TabIndex = 35
Top = 3240
Width = 885
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Jumlah Uang:"
ForeColor = &H80000008&
Height = 300
Index = 13
Left = 240
TabIndex = 33
Top = 2640
Width = 1335
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Total Bayar:"
ForeColor = &H80000008&
Height = 300
Index = 12
Left = 360
TabIndex = 31
Top = 1800
Width = 1185
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "PPN:"
ForeColor = &H80000008&
Height = 300
Index = 11
Left = 1080
TabIndex = 29
Top = 1320
Width = 465
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Potongan:"
ForeColor = &H80000008&
Height = 300
Index = 10
Left = 525
TabIndex = 27
Top = 840
Width = 1035
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Biaya:"
ForeColor = &H80000008&
Height = 300
Index = 9
Left = 960
TabIndex = 25
Top = 360
Width = 615
End
End
Begin VB.CommandButton Command1
Caption = "K&eluar"
BeginProperty Font
Name = "Segoe UI"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 2
Left = 4800
TabIndex = 38
Top = 6480
Width = 3975
End
Begin VB.Frame Frame1
BeginProperty Font
Name = "Segoe UI"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 4545
Index = 1
Left = 120
TabIndex = 11
Top = 3000
Width = 4455
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
Height = 375
Index = 5
Left = 2280
Locked = -1 'True
TabIndex = 21
TabStop = 0 'False
Top = 3240
Width = 1695
End
Begin VB.TextBox Text1
Height = 375
Index = 6
Left = 2280
Locked = -1 'True
TabIndex = 23
TabStop = 0 'False
Top = 3960
Width = 1695
End
Begin VB.Frame Frame1
Caption = "Penumpang:"
Height = 2775
Index = 2
Left = 240
TabIndex = 12
Top = 240
Width = 3975
Begin VB.CommandButton Command1
Caption = "Hitung"
Enabled = 0 'False
Height = 495
Index = 0
Left = 240
TabIndex = 19
Top = 2040
Width = 3495
End
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
BackColor = &H8000000F&
Enabled = 0 'False
Height = 375
Index = 4
Left = 2040
TabIndex = 18
Top = 1440
Width = 1695
End
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
BackColor = &H8000000F&
Enabled = 0 'False
Height = 375
Index = 3
Left = 2040
TabIndex = 16
Top = 960
Width = 1695
End
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
BackColor = &H8000000F&
Enabled = 0 'False
Height = 375
Index = 2
Left = 2040
TabIndex = 14
Top = 480
Width = 1695
End
Begin VB.CheckBox Check1
Caption = "Lansia"
Height = 495
Index = 2
Left = 240
TabIndex = 17
Top = 1320
Width = 1215
End
Begin VB.CheckBox Check1
Caption = "Dewasa"
Height = 495
Index = 1
Left = 240
TabIndex = 15
Top = 840
Width = 1215
End
Begin VB.CheckBox Check1
Caption = "Anak"
Height = 495
Index = 0
Left = 240
TabIndex = 13
Top = 360
Width = 1215
End
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Jumlah Tiket:"
ForeColor = &H80000008&
Height = 300
Index = 7
Left = 600
TabIndex = 20
Top = 3240
Width = 1305
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Biaya Asuransi:"
ForeColor = &H80000008&
Height = 300
Index = 8
Left = 480
TabIndex = 22
Top = 3960
Width = 1485
End
End
Begin VB.Frame Frame1
BeginProperty Font
Name = "Segoe UI"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1935
Index = 0
Left = 120
TabIndex = 4
Top = 960
Width = 4455
Begin VB.TextBox Text1
Height = 375
Index = 1
Left = 2280
Locked = -1 'True
TabIndex = 10
TabStop = 0 'False
Top = 1320
Width = 1695
End
Begin VB.TextBox Text1
Height = 375
Index = 0
Left = 2280
Locked = -1 'True
TabIndex = 8
TabStop = 0 'False
Top = 840
Width = 1935
End
Begin VB.ComboBox Combo1
Height = 420
Left = 2280
TabIndex = 6
Text = "Combo1"
Top = 360
Width = 1695
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Harga Tiket:"
ForeColor = &H80000008&
Height = 300
Index = 6
Left = 600
TabIndex = 9
Top = 1320
Width = 1215
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Nama Kereta:"
ForeColor = &H80000008&
Height = 300
Index = 5
Left = 480
TabIndex = 7
Top = 840
Width = 1365
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Kode Kereta:"
ForeColor = &H80000008&
Height = 300
Index = 4
Left = 480
TabIndex = 5
Top = 360
Width = 1305
End
End
Begin VB.Timer Timer1
Interval = 1000
Left = 5640
Top = 240
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Label1"
ForeColor = &H00FFFFFF&
Height = 255
Index = 3
Left = 6240
TabIndex = 3
Top = 465
Width = 2490
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Label1"
ForeColor = &H00FFFFFF&
Height = 255
Index = 2
Left = 6240
TabIndex = 2
Top = 165
Width = 2490
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "STASIUN KERETA API BSI"
BeginProperty Font
Name = "Segoe UI"
Size = 20.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 555
Index = 0
Left = 120
TabIndex = 0
Top = 120
Width = 4380
End
Begin VB.Label Label1
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "STASIUN KERETA API BSI"
BeginProperty Font
Name = "Segoe UI"
Size = 20.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 555
Index = 1
Left = 165
TabIndex = 1
Top = 120
Width = 4380
End
Begin VB.Shape Shape1
BackColor = &H000080FF&
BackStyle = 1 'Opaque
BorderColor = &H00000000&
BorderStyle = 0 'Transparent
Height = 975
Left = 0
Top = 0
Width = 9135
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim HargaTiket, TotalBayar As Currency
Private Sub Check1_Click(Index As Integer)
Select Case Index
Case 0:
If Check1(Index).Value = 1 Then
With Text1(2)
.Enabled = True
.BackColor = SystemColorConstants.vbWindowBackground
.SetFocus
End With
Command1(Index).Enabled = True
Else
With Text1(2)
.Enabled = False
.BackColor = SystemColorConstants.vbButtonFace
End With
Command1(Index).Enabled = False
End If
Case 1:
If Check1(Index).Value = 1 Then
With Text1(3)
.Enabled = True
.BackColor = SystemColorConstants.vbWindowBackground
.SetFocus
End With
Command1(0).Enabled = True
Else
With Text1(3)
.Enabled = False
.BackColor = SystemColorConstants.vbButtonFace
End With
Command1(0).Enabled = False
End If
Case 2:
If Check1(Index).Value = 1 Then
With Text1(4)
.Enabled = True
.BackColor = SystemColorConstants.vbWindowBackground
.SetFocus
End With
Command1(0).Enabled = True
Else
With Text1(4)
.Enabled = False
.BackColor = SystemColorConstants.vbButtonFace
End With
Command1(0).Enabled = False
End If
End Select
End Sub
Private Sub Combo1_Click()
Select Case Combo1.ListIndex
Case 0:
Text1(0).Text = "Argo Bromo"
HargaTiket = 120000
Case 1:
Text1(0).Text = "Argo Lawu"
HargaTiket = 150000
Case 2:
Text1(0).Text = "Cirebon Express"
HargaTiket = 90000
Case 3:
Text1(0).Text = "Bandung Express"
HargaTiket = 75000
End Select
Text1(1).Text = Format(HargaTiket, "Currency")
End Sub
Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0:
Dim Anak, Dewasa, Lansia As Integer
Dim JumlahAnak, JumlahDewasa, JumlahLansia As Integer
Dim Asuransi, Biaya, PPN As Currency
Anak = 11250 * Val(Text1(2).Text)
Dewasa = 3750 * Val(Text1(3).Text)
Lansia = 7500 * Val(Text1(4).Text)
If Check1(0).Value = 1 Then
Asuransi = Anak
ElseIf Check1(1).Value = 1 Then
Asuransi = Dewasa
ElseIf Check1(2).Value = 1 Then
Asuransi = Lansia
End If
If Check1(0).Value = 1 And Check1(1).Value = 1 Then
Asuransi = Anak + Dewasa
ElseIf Check1(0).Value = 1 And Check1(2).Value = 1 Then
Asuransi = Anak + Lansia
ElseIf Check1(1).Value = 1 And Check1(2).Value = 1 Then
Asuransi = Dewasa + Lansia
End If
If Check1(0).Value = 1 And Check1(1).Value = 1 And Check1(2).Value = 1 Then
Asuransi = Anak + Dewasa + Lansia
End If
JumlahAnak = Val(Text1(2).Text)
JumlahDewasa = Val(Text1(3).Text)
JumlahLansia = Val(Text1(4).Text)
Text1(5).Text = JumlahAnak + JumlahDewasa + JumlahLansia
Text1(6).Text = Format(Asuransi, "Currency")
Biaya = HargaTiket * Val(Text1(5).Text) + Asuransi
Text1(7).Text = Format(Biaya, "Currency")
Dim DiskonAnak, DiskonDewasa, DiskonLansia, JumlahDiskon As Currency
DiskonAnak = HargaTiket * JumlahAnak * 0.15
DiskonLansia = HargaTiket * JumlahLansia * 0.1
If JumlahDewasa > 4 Then
DiskonDewasa = HargaTiket * JumlahDewasa * 0.1
End If
JumlahDiskon = DiskonAnak + DiskonDewasa + DiskonLansia
Text1(8).Text = Format(JumlahDiskon, "Currency")
PPN = Biaya * 0.1
Text1(9).Text = Format(PPN, "Currency")
TotalBayar = Biaya - JumlahDiskon + PPN
Text1(10).Text = Format(TotalBayar, "Currency")
Command1(Index).Enabled = False
Text1(11).SetFocus
Case 1:
If Command1(Index).Caption = "Proses" Then
Dim UangBayar#, UangKembali#
UangBayar = Val(Text1(11).Text)
Text1(11).Text = Format(UangBayar, "Currency")
UangKembali = UangBayar - TotalBayar
Text1(12).Text = Format(UangKembali, "Currency")
Command1(Index).Caption = "Transaksi Baru"
Command1(Index).SetFocus
Else
Dim i%
For i = 0 To 2
Check1(i).Value = 0
Next
For i = 0 To 12
Text1(i).Text = Empty
Next
Combo1.Clear
Command1(Index).Caption = "Proses"
Combo1.SetFocus
Form_Load
End If
Case 2:
Unload Me
End Select
End Sub
Private Sub Form_Load()
With Combo1
.Text = "--- Pilih ---"
.AddItem "AB"
.AddItem "AL"
.AddItem "CE"
.AddItem "BE"
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MsgBox("Keluar program ?", vbQuestion + vbYesNo, "Perhatian") = vbNo Then
Cancel = 1
End If
End Sub
Private Sub Text1_Change(Index As Integer)
Select Case Index
Case 11:
If Len(Text1(Index).Text) > 0 Then
Command1(1).Enabled = True
Else
Command1(1).Enabled = False
End If
End Select
End Sub
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
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
End If
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.26.00
0 Komentar
0 Komentar:
Posting Komentar
Berlangganan Posting Komentar [Atom]
<< Beranda