Jumat, 24 Oktober 2014

“Toko Kue dan Roti” dengan Visual Basic 6.0

VB6SP6_logo

Contoh latihan Visual Basic 6.0 “Toko Kue dan Roti” yang terdapat pada blog “Adam Khamarullah”.

Sedikit modifikasi yang dibuat yaitu dengan penggunaan kontrol berindex. Untuk lebih lengkapnya dapat dilihat pada kode sumber yang disertakan.

 

 

TokoKue_Roti

VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Kue dan Roti"
ClientHeight = 5685
ClientLeft = 45
ClientTop = 330
ClientWidth = 10470
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 = 5685
ScaleWidth = 10470
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton Command1
Caption = "Proses Transaksi"
Enabled = 0 'False
Height = 495
Index = 1
Left = 5880
TabIndex = 25
Top = 5040
Width = 4335
End
Begin VB.TextBox Text1
Height = 420
Index = 9
Left = 7920
Locked = -1 'True
TabIndex = 24
TabStop = 0 'False
Top = 4440
Width = 2295
End
Begin VB.TextBox Text1
Height = 420
Index = 8
Left = 7920
TabIndex = 22
Top = 3840
Width = 2295
End
Begin VB.TextBox Text1
Height = 420
Index = 7
Left = 7920
Locked = -1 'True
TabIndex = 20
TabStop = 0 'False
Top = 3120
Width = 2295
End
Begin VB.TextBox Text1
Height = 420
Index = 6
Left = 7920
Locked = -1 'True
TabIndex = 18
TabStop = 0 'False
Top = 2520
Width = 2295
End
Begin VB.TextBox Text1
Height = 420
Index = 5
Left = 7920
Locked = -1 'True
TabIndex = 16
TabStop = 0 'False
Top = 1920
Width = 2295
End
Begin VB.TextBox Text1
Height = 420
Index = 4
Left = 7920
Locked = -1 'True
TabIndex = 14
TabStop = 0 'False
Top = 1320
Width = 2295
End
Begin VB.Frame Frame1
Caption = "Jenis Kue/Roti"
Height = 3015
Left = 120
TabIndex = 4
Top = 960
Width = 5175
Begin VB.TextBox Text1
Height = 420
Index = 3
Left = 2400
TabIndex = 12
Top = 2280
Width = 2295
End
Begin VB.TextBox Text1
Height = 420
Index = 2
Left = 2400
TabIndex = 10
Top = 1680
Width = 2295
End
Begin VB.TextBox Text1
Height = 420
Index = 1
Left = 2400
TabIndex = 8
Top = 1080
Width = 2295
End
Begin VB.TextBox Text1
Height = 420
Index = 0
Left = 2400
TabIndex = 6
Top = 480
Width = 2295
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Jumlah Pembelian:"
Height = 300
Index = 7
Left = 360
TabIndex = 11
Top = 2295
Width = 1845
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Harga Kue/Roti:"
Height = 300
Index = 6
Left = 600
TabIndex = 9
Top = 1725
Width = 1590
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Jenis Kue/Roti:"
Height = 300
Index = 5
Left = 720
TabIndex = 7
Top = 1125
Width = 1440
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Kode Kue/Roti:"
Height = 300
Index = 4
Left = 645
TabIndex = 5
Top = 540
Width = 1500
End
End
Begin VB.CommandButton Command1
Caption = "K&eluar"
Height = 495
Index = 0
Left = 120
TabIndex = 26
Top = 5040
Width = 2055
End
Begin VB.Timer Timer1
Interval = 1000
Left = 120
Top = 4080
End
Begin VB.Line Line1
Index = 0
X1 = 120
X2 = 5280
Y1 = 4920
Y2 = 4920
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Uang Kembali:"
Height = 300
Index = 13
Left = 6240
TabIndex = 23
Top = 4485
Width = 1455
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Uang Pembayaran:"
Height = 300
Index = 12
Left = 5880
TabIndex = 21
Top = 3855
Width = 1860
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Total Bayar:"
Height = 300
Index = 11
Left = 6525
TabIndex = 19
Top = 3180
Width = 1170
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "PPN:"
Height = 300
Index = 10
Left = 7275
TabIndex = 17
Top = 2565
Width = 450
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Potongan:"
Height = 300
Index = 9
Left = 6705
TabIndex = 15
Top = 1965
Width = 1005
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Pembayaran:"
Height = 300
Index = 8
Left = 6420
TabIndex = 13
Top = 1335
Width = 1275
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Label1"
ForeColor = &H00FFFFFF&
Height = 300
Index = 3
Left = 7560
TabIndex = 3
Top = 465
Width = 2700
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Label1"
ForeColor = &H00FFFFFF&
Height = 300
Index = 2
Left = 7560
TabIndex = 2
Top = 165
Width = 2700
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "TOKO KUE DAN ROTI ""NIKMAT"""
BeginProperty Font
Name = "Segoe UI"
Size = 20.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 555
Index = 1
Left = 240
TabIndex = 1
Top = 120
Width = 6180
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "TOKO KUE DAN ROTI ""NIKMAT"""
BeginProperty Font
Name = "Segoe UI"
Size = 20.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Index = 0
Left = 280
TabIndex = 0
Top = 160
Width = 6180
End
Begin VB.Shape Shape1
BackColor = &H000080FF&
BackStyle = 1 'Opaque
BorderStyle = 0 'Transparent
Height = 1095
Left = -120
Top = -120
Width = 10695
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
BorderWidth = 2
Index = 1
X1 = 120
X2 = 5280
Y1 = 4920
Y2 = 4920
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim HargaEceran, TotalBayar As Currency

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 8:
If Len(Text1(8).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)
Select Case Index
Case 0:
Dim Karakter$

Karakter = "~`!@#$%^&*()-_+=[]{}:;'<>,.?/\|"

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

HargaEceran = Val(Text1(Index).Text)
Text1(Index).Text = Format(HargaEceran, "Currency")
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

Dim Bayar, Diskon, PPN As Currency
Dim JumlahBeli As Integer

JumlahBeli = Val(Text1(Index).Text)
Bayar = HargaEceran * JumlahBeli
Text1(4).Text = Format(Bayar, "Currency")

If JumlahBeli >= 3 Then
Diskon = Bayar * 0.07
Else
Diskon = 0
End If
Text1(5).Text = Format(Diskon, "Currency")

PPN = Bayar * 0.03
Text1(6).Text = Format(PPN, "Currency")

TotalBayar = Bayar - Diskon + PPN
Text1(7).Text = Format(TotalBayar, "Currency")
End If
Case 8:
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
Command1_Click (1)
End If
End Select
End Sub

Private Sub Command1_Click(Index As Integer)
Dim UangBayar, UangKembali As Currency

Select Case Index
Case 0:
Unload Me
Case 1:
If Command1(Index).Caption = "Proses Transaksi" Then
UangBayar = Val(Text1(8).Text)
Text1(8).Text = Format(UangBayar, "Currency")

UangKembali = UangBayar - TotalBayar
Text1(9).Text = Format(UangKembali, "Currency")
Command1(Index).Caption = "Transaksi Baru"
Command1(Index).SetFocus
Else
Dim i%

For i = 0 To 9
Text1(i).Text = Empty
Next

Command1(Index).Caption = "Proses Transaksi"
Text1(0).SetFocus
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:

0 Komentar:

Posting Komentar

Berlangganan Posting Komentar [Atom]

<< Beranda