Jumat, 03 Oktober 2014

“Menghitung Luas Bangunan” dengan Visual Basic 6.0

VB6SP6_logo

Percontohan “Menghitung Luas Bangunan” yang terdapat pada blog “Ketik Visual Basic!”.

Tidak ada banyak modifikasi yang dibuat. Hanya sekedar menambahkan fungsi tombol “Baru”. Untuk lebih lengkapnya dapat dilihat pada kode sumber yang disertakan.

 

 

Luas_Bangunan

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Menghitung Luas Bangunan"
ClientHeight = 3630
ClientLeft = 45
ClientTop = 405
ClientWidth = 5685
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 = 3630
ScaleWidth = 5685
StartUpPosition = 2 'CenterScreen
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 10
Top = 3255
Visible = 0 'False
Width = 5685
_ExtentX = 10028
_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.Frame Frame1
Caption = "Masukan Nilai Data:"
Height = 2175
Left = 120
TabIndex = 1
Top = 600
Width = 5415
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
Height = 375
Index = 0
Left = 1440
TabIndex = 3
Top = 480
Visible = 0 'False
Width = 1095
End
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
Height = 375
Index = 1
Left = 3960
TabIndex = 5
Top = 480
Visible = 0 'False
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "Hitung Luas"
Height = 495
Index = 1
Left = 360
TabIndex = 6
Top = 960
Visible = 0 'False
Width = 4695
End
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
Height = 375
Index = 2
Left = 2880
Locked = -1 'True
TabIndex = 8
Top = 1560
Visible = 0 'False
Width = 2175
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Label1"
Height = 255
Index = 0
Left = 360
TabIndex = 2
Top = 480
Visible = 0 'False
Width = 570
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Label1"
Height = 255
Index = 1
Left = 2880
TabIndex = 4
Top = 480
Visible = 0 'False
Width = 570
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Label1"
Height = 255
Index = 2
Left = 360
TabIndex = 7
Top = 1605
Visible = 0 'False
Width = 570
End
End
Begin VB.CommandButton Command1
Caption = "K&eluar"
Height = 495
Index = 0
Left = 4200
TabIndex = 9
Top = 3000
Width = 1215
End
Begin VB.ComboBox Combo1
Height = 375
Left = 120
TabIndex = 0
Text = "Pilih Bangunan..."
Top = 120
Width = 5415
End
Begin VB.Line Line1
Index = 0
X1 = 120
X2 = 5520
Y1 = 2880
Y2 = 2880
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
BorderWidth = 4
Index = 1
X1 = 120
X2 = 5520
Y1 = 2880
Y2 = 2880
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 Bersihkan()
For i = 0 To 2
Text1(i).Text = Empty
Next
Command1(1).Caption = "Hitung Luas"
End Sub

Private Sub Combo1_Click()
Select Case Combo1.Text
Case "Bujur Sangkar"
Tampilan_SatuKolom_Masukan
Bersihkan
Label1(0).Caption = "Sisi :"
Label1(2).Caption = "Luas " & Combo1.Text & ":"
Text1(0).SetFocus
Case "Persegi Panjang"
Tampilan_DuaKolom_Masukan
Bersihkan
Label1(0).Caption = "Panjang :"
Label1(1).Caption = "Lebar :"
Label1(2).Caption = "Luas " & Combo1.Text & ":"
Text1(0).SetFocus
Case "Lingkaran"
Tampilan_SatuKolom_Masukan
Bersihkan
Label1(0).Caption = "Jari-jari :"
Label1(2).Caption = "Luas " & Combo1.Text & ":"
Text1(0).SetFocus
Case "Segitiga Siku-siku"
Tampilan_DuaKolom_Masukan
Bersihkan
Label1(0).Caption = "Alas :"
Label1(1).Caption = "Tinggi :"
Label1(2).Caption = "Luas " & Combo1.Text & ":"
Text1(0).SetFocus
End Select
End Sub

Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0:
Unload Me
Case 1:
Dim Nilai1%, Nilai2%
If Combo1.Text = "Bujur Sangkar" Then
If Text1(0).Text = Empty Then
MsgBox "Anda belum mengisi data apapun...!", _
vbInformation, "Perhatian"
Text1(0).SetFocus
Exit Sub
End If

If Command1(Index).Caption = "Hitung Luas" Then
Nilai1 = Val(Text1(0).Text)
Text1(2).Text = Nilai1 * Nilai1
With Command1(Index)
.Caption = "Baru"
.SetFocus
End With
Else
Bersihkan
Text1(0).SetFocus
End If
ElseIf Combo1.Text = "Persegi Panjang" Then
If Text1(0).Text = Empty Then
MsgBox "Anda belum mengisi data kolom 1...!", _
vbInformation, "Perhatian"
Text1(0).SetFocus
Exit Sub
End If

If Text1(1).Text = Empty Then
MsgBox "Anda belum mengisi data kolom 2...!", _
vbInformation, "Perhatian"
Text1(1).SetFocus
Exit Sub
End If

If Command1(Index).Caption = "Hitung Luas" Then
Nilai1 = Val(Text1(0).Text)
Nilai2 = Val(Text1(1).Text)
Text1(2).Text = Nilai1 * Nilai2
With Command1(Index)
.Caption = "Baru"
.SetFocus
End With
Else
Bersihkan
Text1(0).SetFocus
End If
ElseIf Combo1.Text = "Lingkaran" Then
If Text1(0).Text = Empty Then
MsgBox "Anda belum mengisi data apapun...!", _
vbInformation, "Perhatian"
Text1(0).SetFocus
Exit Sub
End If

Const Phi As Single = 3.14
If Command1(Index).Caption = "Hitung Luas" Then
Nilai1 = Val(Text1(0).Text)
Text1(2).Text = Phi * Nilai1 * Nilai1
With Command1(Index)
.Caption = "Baru"
.SetFocus
End With
Else
Bersihkan
Text1(0).SetFocus
End If
ElseIf Combo1.Text = "Segitiga Siku-siku" Then
If Text1(0).Text = Empty Then
MsgBox "Anda belum mengisi data kolom 1...!", _
vbInformation, "Perhatian"
Text1(0).SetFocus
Exit Sub
End If

If Text1(1).Text = Empty Then
MsgBox "Anda belum mengisi data kolom 2...!", _
vbInformation, "Perhatian"
Text1(1).SetFocus
Exit Sub
End If

If Command1(Index).Caption = "Hitung Luas" Then
Nilai1 = Val(Text1(0).Text)
Nilai2 = Val(Text1(1).Text)
Text1(2).Text = 0.5 * (Nilai1 * Nilai2)
With Command1(Index)
.Caption = "Baru"
.SetFocus
End With
Else
Bersihkan
Text1(0).SetFocus
End If
End If
End Select
End Sub

Private Sub Form_Load()
Combo1.AddItem "Bujur Sangkar"
Combo1.AddItem "Persegi Panjang"
Combo1.AddItem "Lingkaran"
Combo1.AddItem "Segitiga Siku-siku"
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 Tampilan_DuaKolom_Masukan()
For i = 0 To 2
Label1(i).Visible = True
Text1(i).Visible = True
Next
Command1(1).Visible = True
End Sub

Private Sub Tampilan_SatuKolom_Masukan()
Label1(0).Visible = True
Label1(1).Visible = False
Label1(2).Visible = True
Text1(0).Visible = True
Text1(1).Visible = False
Text1(2).Visible = True
Command1(1).Visible = True
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
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub


Unduh Kode Sumber

Label:

0 Komentar:

Posting Komentar

Berlangganan Posting Komentar [Atom]

<< Beranda