Selasa, 30 September 2014

“Latihan 6 Visual Basic” dengan Visual Basic 6.0

VB6SP6_logo

Modifikasi “Latihan 6 Visual Basic” yang terdapat pada blog Yulis Riyadi.

Tidak banyak modifikasi yang dibuat. Hanya sekedar menambahkan beberapa fungsi tambahan seperti menambahkan tombol “Baru” dan lain sebagainya. Untuk lebih lengkapnya dapat dilihat pada kode sumber yang disertakan.

 

 

TokoGrosir_Sederhana

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Toko Grosir ""Pasti Untung"""
ClientHeight = 4815
ClientLeft = 45
ClientTop = 375
ClientWidth = 7350
BeginProperty Font
Name = "Segoe UI"
Size = 9
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 = 4815
ScaleWidth = 7350
StartUpPosition = 2 'CenterScreen
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 18
Top = 4440
Visible = 0 'False
Width = 7350
_ExtentX = 12965
_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.CommandButton Command1
Caption = "Baru"
Enabled = 0 'False
Height = 495
Index = 2
Left = 240
TabIndex = 17
Top = 3360
Width = 2535
End
Begin VB.CommandButton Command1
Caption = "Keluar"
Height = 495
Index = 1
Left = 240
TabIndex = 16
Top = 4080
Width = 6855
End
Begin VB.Frame Frame1
Caption = "Transaksi:"
Height = 3615
Left = 3000
TabIndex = 5
Top = 240
Width = 4095
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
BeginProperty Font
Name = "Segoe UI"
Size = 15.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 525
Index = 5
Left = 240
Locked = -1 'True
TabIndex = 15
Top = 2640
Width = 3615
End
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
Height = 330
Index = 4
Left = 1680
Locked = -1 'True
TabIndex = 13
Top = 1815
Width = 2175
End
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
Height = 330
Index = 3
Left = 1680
Locked = -1 'True
TabIndex = 11
Top = 1335
Width = 2175
End
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
Height = 330
Index = 2
Left = 1680
Locked = -1 'True
TabIndex = 9
Top = 840
Width = 2175
End
Begin VB.TextBox Text1
Height = 330
Index = 1
Left = 1680
Locked = -1 'True
TabIndex = 7
Top = 360
Width = 2175
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Total Bayar:"
BeginProperty Font
Name = "Segoe UI"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Index = 6
Left = 1320
TabIndex = 14
Top = 2280
Width = 1170
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Diskon:"
Height = 225
Index = 5
Left = 240
TabIndex = 12
Top = 1830
Width = 585
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Jumlah Bayar:"
Height = 225
Index = 4
Left = 240
TabIndex = 10
Top = 1350
Width = 1095
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Harga Satuan:"
Height = 225
Index = 3
Left = 240
TabIndex = 8
Top = 870
Width = 1110
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Nama Barang:"
Height = 225
Index = 2
Left = 240
TabIndex = 6
Top = 390
Width = 1125
End
End
Begin VB.CommandButton Command1
Caption = "Proses"
Enabled = 0 'False
Height = 495
Index = 0
Left = 240
TabIndex = 4
Top = 2760
Width = 2535
End
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
Height = 330
Index = 0
Left = 1560
TabIndex = 3
Top = 2250
Width = 1215
End
Begin VB.ListBox List1
Height = 1635
Left = 240
TabIndex = 1
Top = 520
Width = 2535
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Jumlah Barang:"
Height = 225
Index = 1
Left = 240
TabIndex = 2
Top = 2280
Width = 1215
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Pilih Barang:"
Height = 225
Index = 0
Left = 240
TabIndex = 0
Top = 240
Width = 990
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim i%

Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0:
If List1.Text = Empty Then
MsgBox "Tidak ada barang yang terpilih !", _
vbExclamation, "Perhatian"
Exit Sub
End If

If Text1(Index).Text = Empty Then
MsgBox "Masukan barang satuan kosong !", _
vbExclamation, "Perhatian"
Text1(0).SetFocus
End If

Dim HargaBarang_Satuan, Total_Bayar As Currency
Dim Jumlah_Barang As Integer
Dim Diskon As Single
Dim Satuan_Barang As String

Select Case List1.Text
Case "Disket"
HargaBarang_Satuan = 35000
Satuan_Barang = "Box"
Case "Buku Tulis"
HargaBarang_Satuan = 20000
Satuan_Barang = "Lusin"
Case "Kertas HVS"
HargaBarang_Satuan = 25000
Satuan_Barang = "Rim"
Case "Pulpen"
HargaBarang_Satuan = 10000
Satuan_Barang = "Pak"
End Select

Text1(1).Text = List1.Text
Text1(2).Text = Format(HargaBarang_Satuan, _
"Currency") & "/" & _
Satuan_Barang
Text1(3).Text = Format(Val(Text1(0).Text) * _
HargaBarang_Satuan, _
"Currency")

Jumlah_Barang = Val(Text1(0).Text)

Select Case Jumlah_Barang
Case Is < 10
Diskon = 0
Case 10 To 20
Diskon = 0.15
Case Else
Diskon = 0.2
End Select

Total_Bayar = Jumlah_Barang * _
(HargaBarang_Satuan * _
(1 - Diskon))

Text1(4).Text = Format(Diskon, "0 %")
Text1(5).Text = Format(Total_Bayar, "Currency")
Command1(Index).Enabled = False
Command1(2).Enabled = True
Command1(2).SetFocus
Case 1:
Dim Respon
Respon = MsgBox("Keluar program ?", _
vbQuestion + vbYesNo, _
"Perhatian")
If Respon = vbYes Then
End
Else
Text1(0).SetFocus
End If
Case 2:
For i = 0 To 5
Text1(i).Text = Empty
Next
List1.Clear
Command1(Index).Enabled = False
Form_Load
End Select
End Sub

Private Sub Form_Load()
With List1
.AddItem "Disket"
.AddItem "Buku Tulis"
.AddItem "Kertas HVS"
.AddItem "Pulpen"
End With
End Sub

Private Sub List1_Click()
Text1(0).SetFocus
End Sub

Private Sub Text1_Change(Index As Integer)
If Text1(0).Text = Empty Then
Command1(0).Enabled = False
Else
Command1(0).Enabled = True
End If
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or _
KeyAscii = vbKeyBack Or KeyAscii = vbKeyReturn) Then
Beep
KeyAscii = 0
End If

If (KeyAscii = 13) Then
Command1_Click (0)
End If
End Sub


Unduh Kode Sumber

Label:

0 Komentar:

Posting Komentar

Berlangganan Posting Komentar [Atom]

<< Beranda