“Pemesanan Tiket Pesawat” dengan Visual Basic 6.0
Percontohan “Pemesanan Tiket Pesawat” yang terdapat pada blog “Adam Khamarullah”.
Sedikit modifikasi yang dibuat, dengan menggunakan kontrol DateTimePicker sebagai pengganti masukan Hari, Bulan dan Tahun yang sebelumnya menggunakan kontrol ComboBox. 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 = "Pemesanan Tiket Pesawat"
ClientHeight = 7605
ClientLeft = 45
ClientTop = 405
ClientWidth = 9750
BeginProperty Font
Name = "Segoe UI"
Size = 9.75
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 = 7605
ScaleWidth = 9750
StartUpPosition = 2 'CenterScreen
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 46
Top = 7230
Visible = 0 'False
Width = 9750
_ExtentX = 17198
_ExtentY = 661
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 9
Left = 1680
Locked = -1 'True
MaxLength = 12
TabIndex = 44
TabStop = 0 'False
Top = 5640
Width = 2415
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 375
Index = 0
Left = 1680
TabIndex = 19
Top = 4680
Width = 2415
_ExtentX = 4260
_ExtentY = 661
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 20774912
CurrentDate = 41928
End
Begin VB.CommandButton Command1
Caption = "Keluar"
BeginProperty Font
Name = "Segoe UI"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 1
Left = 7560
TabIndex = 43
Top = 1080
Width = 2055
End
Begin VB.CommandButton Command1
Caption = "Proses"
Enabled = 0 'False
BeginProperty Font
Name = "Segoe UI"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 0
Left = 4920
TabIndex = 42
Top = 6600
Width = 4215
End
Begin VB.Frame Frame3
Caption = "Pembayaran:"
Height = 1455
Left = 4920
TabIndex = 37
Top = 5040
Width = 4215
Begin VB.TextBox Text1
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 8
Left = 1560
MaxLength = 12
TabIndex = 39
Top = 360
Width = 2295
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 7
Left = 1560
Locked = -1 'True
MaxLength = 12
TabIndex = 38
TabStop = 0 'False
Top = 840
Width = 2295
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Cash:"
Height = 255
Index = 20
Left = 840
TabIndex = 41
Top = 405
Width = 465
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Kembali:"
Height = 255
Index = 19
Left = 600
TabIndex = 40
Top = 885
Width = 750
End
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 6
Left = 6480
Locked = -1 'True
MaxLength = 12
TabIndex = 34
TabStop = 0 'False
Top = 3960
Width = 2295
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 5
Left = 6480
Locked = -1 'True
MaxLength = 12
TabIndex = 33
TabStop = 0 'False
Top = 4440
Width = 2295
End
Begin VB.Frame Frame2
Caption = "Bagasi:"
Height = 1095
Left = 4320
TabIndex = 29
Top = 2640
Width = 5175
Begin VB.CheckBox Check1
Caption = "30 - 50 Kg"
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 2
Left = 3480
TabIndex = 32
Top = 360
Width = 1455
End
Begin VB.CheckBox Check1
Caption = "16 - 30 Kg"
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 1
Left = 1860
TabIndex = 31
Top = 360
Width = 1455
End
Begin VB.CheckBox Check1
Caption = "0 - 16 Kg"
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 0
Left = 360
TabIndex = 30
Top = 360
Width = 1335
End
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 4
Left = 1680
MaxLength = 12
TabIndex = 25
Top = 6840
Width = 2415
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 3
Left = 1680
MaxLength = 12
TabIndex = 23
Top = 6120
Width = 2415
End
Begin VB.Timer Timer1
Interval = 1000
Left = 6720
Top = 120
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 2
Left = 1680
Locked = -1 'True
MaxLength = 12
TabIndex = 17
TabStop = 0 'False
Top = 4200
Width = 2415
End
Begin VB.OptionButton Option1
Caption = "Ekonomi"
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 1
Left = 2880
TabIndex = 15
Top = 3720
Width = 1335
End
Begin VB.OptionButton Option1
Caption = "Bisnis"
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 1680
TabIndex = 14
Top = 3720
Width = 975
End
Begin VB.ComboBox Combo1
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Index = 1
Left = 1680
TabIndex = 12
Text = "Kota Tujuan"
Top = 3240
Width = 2415
End
Begin VB.ComboBox Combo1
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Index = 0
Left = 1680
TabIndex = 10
Text = "Kota Asal"
Top = 2760
Width = 2415
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 375
Index = 1
Left = 1680
TabIndex = 21
Top = 5160
Width = 2415
_ExtentX = 4260
_ExtentY = 661
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 20774912
CurrentDate = 41928
End
Begin VB.Frame Frame1
Height = 1575
Left = 2040
TabIndex = 3
Top = 960
Width = 4335
Begin VB.TextBox Text1
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 1
Left = 1800
MaxLength = 12
TabIndex = 7
Top = 840
Width = 2295
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 1800
TabIndex = 6
Top = 360
Width = 2295
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "0 Nomor"
BeginProperty Font
Name = "Segoe UI"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 5
Left = 1800
TabIndex = 8
Top = 1230
Width = 2205
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "No. Telepon:"
Height = 255
Index = 4
Left = 520
TabIndex = 5
Top = 880
Width = 1125
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Nama Pemesan:"
Height = 255
Index = 3
Left = 240
TabIndex = 4
Top = 400
Width = 1410
End
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Lama Pejalanan:"
Height = 255
Index = 21
Left = 165
TabIndex = 45
Top = 5685
Width = 1395
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Sub Total:"
Height = 255
Index = 18
Left = 5355
TabIndex = 36
Top = 4005
Width = 870
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Total Bayar:"
Height = 255
Index = 17
Left = 5280
TabIndex = 35
Top = 4485
Width = 1020
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Usia < 3 Tahun"
Height = 255
Index = 16
Left = 2700
TabIndex = 28
Top = 7185
Width = 1320
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Usia >= 3 Tahun"
Height = 255
Index = 15
Left = 2565
TabIndex = 27
Top = 6465
Width = 1455
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Anak-Anak:"
Height = 255
Index = 14
Left = 600
TabIndex = 24
Top = 6885
Width = 960
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Dewasa:"
Height = 255
Index = 13
Left = 795
TabIndex = 22
Top = 6165
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "GRAHA TRAVEL"
BeginProperty Font
Name = "Tahoma"
Size = 27.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF8080&
Height = 675
Index = 12
Left = 135
TabIndex = 26
Top = 45
Width = 3855
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Jam"
Height = 255
Index = 2
Left = 7635
TabIndex = 2
Top = 360
Width = 1950
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Tanggal"
Height = 255
Index = 1
Left = 7515
TabIndex = 1
Top = 75
Width = 2070
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "GRAHA TRAVEL"
BeginProperty Font
Name = "Tahoma"
Size = 27.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 675
Index = 0
Left = 120
TabIndex = 0
Top = 0
Width = 3855
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Kembali:"
Height = 255
Index = 11
Left = 765
TabIndex = 20
Top = 5220
Width = 750
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Berangkat:"
Height = 255
Index = 10
Left = 600
TabIndex = 18
Top = 4740
Width = 915
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Harga Tiket:"
Height = 255
Index = 9
Left = 480
TabIndex = 16
Top = 4245
Width = 1050
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Kelas Kabin:"
Height = 255
Index = 8
Left = 435
TabIndex = 13
Top = 3765
Width = 1065
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Tujuan:"
Height = 255
Index = 7
Left = 885
TabIndex = 11
Top = 3285
Width = 615
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Asal:"
Height = 255
Index = 6
Left = 1065
TabIndex = 9
Top = 2805
Width = 405
End
Begin VB.Shape Shape1
BackColor = &H00FFFFFF&
BackStyle = 1 'Opaque
Height = 855
Left = -120
Top = 0
Width = 10215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim TotalHarga As Currency
Private Sub Check1_Click(Index As Integer)
Dim Dewasa, Anak2, BiayaDewasa, BiayaAnak, _
Bagasi, SubTotal As Currency
Select Case Index
Case 0:
Bagasi = 30000
Case 1:
Bagasi = 60000
Case 2:
Bagasi = 90000
End Select
Dewasa = Text1(3).Text
Anak2 = Text1(4).Text
BiayaDewasa = Text1(2).Text
BiayaAnak = 0.15 * BiayaDewasa
SubTotal = (Dewasa * BiayaDewasa) + (Anak2 * BiayaAnak)
TotalHarga = SubTotal + Bagasi
Text1(6).Text = Format(SubTotal, "Currency")
Text1(5).Text = Format(TotalHarga, "Currency")
Text1(8).SetFocus
End Sub
Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0:
If Command1(Index).Caption = "Proses" Then
Text1(7).Text = Format(Val(Text1(8).Text) - TotalHarga, "Currency")
Command1(Index).Caption = "Baru"
Else
Command1(Index).Caption = "Proses"
Dim i%
For i = 0 To 2
Check1(i).Value = 0
Next
For i = 0 To 9
Text1(i).Text = Empty
Next
For i = 0 To 1
Option1(i).Value = False
Combo1(i).Clear
DTPicker1(i).Value = Now
Next
Form_Load
Combo1(Index).Text = "Kota Asal"
Combo1(1).Text = "Kota Tujuan"
Text1(0).SetFocus
End If
Case 1:
Unload Me
End Select
End Sub
Private Sub DTPicker1_Change(Index As Integer)
Select Case Index
Case 1:
If DTPicker1(1).Value < DTPicker1(0).Value Then
MsgBox "Tanggal Kembali tidak boleh kurang dari Tanggal Berangkat...!", vbInformation, "Informasi"
End If
Text1(9).Text = DTPicker1(1).Value - DTPicker1(0).Value
If Val(Text1(9).Text) = 7 Then
Text1(9).Text = "1 Minggu"
ElseIf Val(Text1(9).Text) = 30 Then
Text1(9).Text = "1 Bulan"
ElseIf Val(Text1(9).Text) = 0 Then
Text1(9).Text = "Pergi Pulang"
Else
Text1(9).Text = Text1(9).Text + " Hari"
End If
Text1(3).SetFocus
End Select
End Sub
Private Sub Form_Load()
With Combo1(0)
.AddItem "Jakarta"
.AddItem "Surabaya"
.AddItem "Denpasar"
End With
With Combo1(1)
.AddItem "Jakarta"
.AddItem "Surabaya"
.AddItem "Denpasar"
End With
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 Option1_Click(Index As Integer)
Select Case Index
Case 0:
If Combo1(Index).ListIndex = Index And Combo1(1).ListIndex = 1 Then
Text1(2).Text = Format(1200000, "Currency")
ElseIf Combo1(Index).ListIndex = Index And Combo1(1).ListIndex = 2 Then
Text1(2).Text = Format(1855000, "Currency")
ElseIf Combo1(Index).ListIndex = 1 And Combo1(1).ListIndex = Index Then
Text1(2).Text = Format(1055000, "Currency")
ElseIf Combo1(Index).ListIndex = 1 And Combo1(1).ListIndex = 2 Then
Text1(2).Text = Format(655000, "Currency")
ElseIf Combo1(Index).ListIndex = 2 And Combo1(1).ListIndex = Index Then
Text1(2).Text = Format(1700000, "Currency")
ElseIf Combo1(Index).ListIndex = 2 And Combo1(1).ListIndex = 1 Then
Text1(2).Text = Format(645000, "Currency")
Else
MsgBox "Pilihan kota Asal dan Tujuan tidak boleh sama...!", vbInformation, "Informasi"
End If
Case 1:
If Combo1(0).ListIndex = 0 And Combo1(Index).ListIndex = Index Then
Text1(2).Text = Format(750000, "Currency")
ElseIf Combo1(0).ListIndex = 0 And Combo1(Index).ListIndex = 2 Then
Text1(2).Text = Format(1050000, "Currency")
ElseIf Combo1(0).ListIndex = Index And Combo1(Index).ListIndex = 0 Then
Text1(2).Text = Format(600000, "Currency")
ElseIf Combo1(0).ListIndex = Index And Combo1(Index).ListIndex = 2 Then
Text1(2).Text = Format(360000, "Currency")
ElseIf Combo1(0).ListIndex = 2 And Combo1(Index).ListIndex = 0 Then
Text1(2).Text = Format(900000, "Currency")
ElseIf Combo1(0).ListIndex = 2 And Combo1(Index).ListIndex = Index Then
Text1(2).Text = Format(300000, "Currency")
Else
MsgBox "Pilihan kota Asal dan Tujuan tidak boleh sama...!", vbInformation, "Informasi"
End If
End Select
End Sub
Private Sub Text1_Change(Index As Integer)
Select Case Index
Case 0:
Dim Masukan%
With Text1(Index)
Masukan = .SelStart
.Text = StrConv(.Text, vbProperCase)
.SelStart = Masukan
End With
Case 1:
Label1(5).Caption = Len(Text1(Index).Text) & " Nomor"
Case 8:
If Len(Text1(8).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)
Select Case Index
Case 0:
Dim Karakter$
Karakter = "~`!@#$%^&*()-_+=[]{}:;'<>,.?/\|"
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 1:
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
Case 3:
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
Case 4:
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
Case 8:
If (KeyAscii = 13) Then
Command1_Click (0)
Text1(8).Text = Format(Text1(8).Text, "Currency")
Command1(0).SetFocus
End If
End Select
End Sub
Private Sub Timer1_Timer()
Label1(1).Caption = Format(Now, "dddd,d mmmm yyyy")
Label1(2).Caption = TimeValue(Format(Now, "hh:mm:ss"))
End Sub
Label: VB6
diposting oleh Guntur Nitiputra @ 01.08.00
0 Komentar
0 Komentar:
Posting Komentar
Berlangganan Posting Komentar [Atom]
<< Beranda