by Anonymous (267 Submissions)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Fri 17th November 2006
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Body Mass Index Calculator (that works!) Fully commented
VBcoders
'On the form create the following
'2 TextBoxes with the names: txtWeight and txtHeight
'2 ListBoxes with the names: lstW and lstH
'1 Command button with the name: cmdCalculate
'4 Labels with the names: lblComment, lblKilograms, lblMeters, and lblBMI
'1 Label with the name: Label1 (default Name) and 9 copies using the selection of Creating a Control Array
'You should now have Label1(0), Label1(1),....thru......Label1(10)
'Check all Control objects Name Property for spelling as listed here!
'Change the StartupPosition property to Center Screen (2) if desired
'Don't worry about the size or placement of any of the contols. The program will change the default properties
'as needed.
'Now just copy everything below into the Code portion of the Form and Run it - that's it!
'The program is FULLY commented for beginners
'Open a new Standard EXE
'On the form create the following
'2 TextBoxes with the names: txtWeight and txtHeight
'2 ListBoxes with the names: lstW and lstH
'1 Command button with the name: cmdCalculate
'4 Labels with the names: lblComment, lblKilograms, lblMeters, and lblBMI
'1 Label with the name: Label1 (default Name) and 9 copies using the selection of Creating a Control Array
'You should now have Label1(0), Label1(1),....thru......Label1(10)
'Change the StartupPosition property to Center Screen (2) if desired
'Don't worry about the size or placement of any of the contols. The program will change the default properties
'as needed.
'Now just copy everything below into the Code portion of the Form and Run it - that's it!
'The program is FULLY commented for beginners
Option Explicit
Dim i, h, w As Variant 'Variables for counting, height(inches), weight(pounds) [Variants]
Dim StrValid As String 'Variable for checking valid entry in txtWeight and txtHeight [String]
Dim ch As Long 'Variable for converted height(meters & meters squared) [Long Number]
Dim cw As Long 'Variable for converted weight(kilograms) [Long Number]
Dim bmi As Long 'Variable for final result of computaions [Long Number]
Dim bodymi As Long 'Variable for final result of computaions {redundant} [Long Number]
Private Sub Form_Load()
For i = 91 To 433 'Minimum to Maximum Weights added to the Weight listbox
lstW.AddItem i
Next i
For i = 58 To 76 'Minimum to Maximum Heights added to the Height listbox
lstH.AddItem i
Next i 'The above are not Enforced in manual TextBox entry
'Exit Sub 'To NOT use the Setup routines
'If you have moved the controls to where you would like them placed
'remove the "'" in front of Exit Sub OR delete all of the following to
'the statement End Sub
'Setup Form and Placement of Controls
'This has NOTHING to do with the program - it is included for Setup ease
With Me
.BorderStyle = 1
.Caption = "Adult Body Mass Index Calculator"
.Height = 4290
'.Left = 0 'Not Used for Default Position
'.StartUpPosition = 2 - This will NOT work! Change the Startup property to Center Screen (2) if desired instead of the Windows default (3)
'.Top = 0 'Not Used for Default Position
.Width = 6945
End With
With txtWeight
.Height = 285
.Left = 2520
.MaxLength = 3
.TabIndex = 0
.Text = ""
.Top = 240
.Width = 375
End With
With lstW
.Height = 645
.Left = 2520
.TabStop = False
.Top = 600
.Width = 855
End With
With txtHeight
.Height = 285
.Left = 2520
.MaxLength = 2
.TabIndex = 1
.Text = ""
.Top = 1320
.Width = 340
End With
With lstH
.Height = 645
.Left = 2520
.TabStop = False
.Top = 1680
.Width = 855
End With
With cmdCalculate
.Caption = "Calculate Conversion"
.Height = 255
.Left = 2520
.TabIndex = 2
.Top = 2400
.Width = 2295
End With
With lblBMI
.Alignment = 2
.BackColor = &H80000014
.BorderStyle = 1
.Caption = ""
.Height = 255
.Left = 3480
.Top = 2760
.Width = 495
End With
With lblComment
.Alignment = 2
.BackColor = &H80000014
.BorderStyle = 1
.Caption = ""
.Height = 375
.Font.Size = 10
.Font.Bold = True
.Left = 360
.Top = 3240
.Width = 6015
End With
With lblKilograms
.Alignment = 2
.BackColor = &H80000014
.BorderStyle = 1
.Caption = ""
.Height = 255
.Left = 4920
.Top = 260
.Width = 495
End With
With lblMeters
.Alignment = 2
.BackColor = &H80000014
.BorderStyle = 1
.Caption = ""
.Height = 255
.Left = 4920
.Top = 1320
.Width = 495
End With
With Label1(0)
.Alignment = 1
.BackStyle = 0
.Caption = "Please Enter Your Weight:"
.Height = 255
.Left = 240
.Top = 285
.Width = 2175
End With
With Label1(1)
.Alignment = 1
.BackStyle = 0
.Caption = "Please Enter Your Height:"
.Height = 255
.Left = 240
.Top = 1365
.Width = 2175
End With
With Label1(2)
.Alignment = 1
.BackStyle = 0
.Caption = "Body Mass Index:"
.Height = 255
.Left = 1920
.Top = 2775
.Width = 1455
End With
With Label1(3)
.Alignment = 0
.BackStyle = 0
.Caption = "in Pounds"
.Height = 255
.Left = 3000
.Top = 285
.Width = 855
End With
With Label1(4)
.Alignment = 0
.BackStyle = 0
.Caption = "in Inches"
.Height = 255
.Left = 3000
.Top = 1365
.Width = 855
End With
With Label1(5)
.Alignment = 2
.BackStyle = 0
.Caption = "Conversion to Meteric"
.Height = 255
.Left = 4320
.Top = 0
.Width = 2055
End With
With Label1(6)
.Alignment = 0
.BackStyle = 0
.Caption = "Kilograms"
.Height = 255
.Left = 5520
.Top = 280
.Width = 1215
End With
With Label1(7)
.Alignment = 0
.BackStyle = 0
.Caption = "Meters Squared"
.Height = 255
.Left = 5520
.Top = 1365
.Width = 1215
End With
With Label1(8)
.Alignment = 0
.BackStyle = 0
.Caption = "BMI"
.Height = 255
.Left = 4080
.Top = 2775
.Width = 975
End With
With Label1(9)
.Alignment = 1
.BackStyle = 0
.Caption = "OR Select Your Weight:"
.Height = 255
.Left = 240
.Top = 720
.Width = 2175
End With
With Label1(10)
.Alignment = 1
.BackStyle = 0
.Caption = "OR Select Your Height:"
.Height = 255
.Left = 240
.Top = 1920
.Width = 2175
End With
'End of setting contol placement
End Sub
'This program is designed for Adults with Heights between 4 foot 8 inches and 6 foot 3 inches tall
'and Weights between 91 and 443 pounds. These are not arbitrary numbers, they are the minimum and
'maximum heights and weights on the Source Chart adapted from:
'"Clinical Guidelines on the Indentifcation, Evaluation, and Treatment of Overweight and Obesity in Adults:
'The Evidence Report"
' To calculate your Body Mass Index, take your weight (in kilograms), and divide by your height
'(in meters) squared.
Private Sub cmdCalculate_Click()
w = Val(txtWeight.Text) 'change text entry to numerical
h = Val(txtHeight.Text) 'change text entry to numerical
If w = 0 And h = 0 Then 'check for Weight and Height entries
lblComment.Caption = "Nothing to Calculate!" 'Msg to inform user no enteries have been made
Exit Sub 'Exit sub if no enteries found
ElseIf w <> 0 And h = 0 Then 'check for Weight and Height entries
lblComment.Caption = "You didn't enter your Height!" 'Msg for absence of Height
Exit Sub 'Exit sub if only one entry found
ElseIf w = 0 And h <> 0 Then 'check for Weight and Height entries
lblComment.Caption = "You didn't enter your Weight!" 'Msg for absence of Weight
Exit Sub 'Exit sub if only one entry found
End If
'inches to meters = inches * 0.0254 - Conversion Formula
'pounds to kilograms = pounds * 0.4536 - Conversion Formula
cw = (w * 0.4536) 'weight in pounds converted to kilograms
ch = ((h * 0.0254) ^ 2) 'height in inches converted to meters then(meters) squared.
lblKilograms.Caption = Str(cw) 'change number to text for display in label
lblMeters.Caption = Str(ch) 'change number to text for display in label
bmi = cw / ch 'Calculate the Body Mass Index using meteric conversion variables
lblBMI.Caption = Str(bmi) 'change number to text for display in label
bodymi = Val(lblBMI.Caption) 'change label caption text to a number for processing below
'this step would not be necessary if the select case below were
'changed to Select Case bmi (already a number)
Select Case bodymi
Case 0 To 18 'range of numbers to show the associated msg in the label caption box
'lblComment.Caption = "You are very underweight"
lblComment.Caption = "Off the Chart!"
Case 19 To 24 'range of numbers to show the associated msg in the label caption box
lblComment.Caption = "Your weight is normal"
Case 25 To 29 'ditto
lblComment.Caption = "You are overweight"
Case 30 To 35 'ditto
lblComment.Caption = "You are obese"
Case 36 To 40 'ditto
lblComment.Caption = "You are very obese"
Case 41 To 54 'ditto
lblComment.Caption = "You are extremely obese"
Case Else 'any number not listed in the other case ranges is shown this msg
lblComment.Caption = "Off the Chart!"
End Select
End Sub
Private Sub lstH_Click()
txtHeight.Text = lstH.Text 'places the selected listbox text (Height) into the textbox for processing
End Sub
Private Sub lstW_Click()
txtWeight.Text = lstW.Text 'places the selected listbox text (Weight) into the textbox for processing
End Sub
Private Sub txtHeight_KeyPress(KeyAscii As Integer)
ValidNum KeyAscii 'Only allow numbers to be entered
End Sub
Private Sub txtWeight_KeyPress(KeyAscii As Integer)
ValidNum KeyAscii 'Only allow numbers to be entered
End Sub
Sub ValidNum(KeyAscii As Integer)
StrValid = "0123456789" 'Numbers that are allowed
If KeyAscii > 26 Then 'Allows for Backspace and Delete but no alpha keys
If InStr(StrValid, Chr(KeyAscii)) = 0 Then KeyAscii = 0 'Key rejection
End If
End Sub
