Visual Basic Helper Routines Pure VB: Temperature Conversion Routines Posted: Monday March 25, 2002 Updated: Monday December 26, 2011 Applies to: VB4-32, VB5, VB6 Developed with: VB6, Windows XP OS restrictions: None Author: VBnet - Randy Birch
Prerequisites
None.

Here are a set of straightforward routines to convert one temperature to another - enter a value in one text box, and the others change to the correct value. The code for validating the entry actually took much longer to write than the code to convert the temperatures, as the demo will show.

The formulas for temperature conversion are:

 Celsius (C) to Kelvin (K) = C + 273.15 Celsius (C) to Fahrenheit (F) = (C * 9/5) + 32 Fahrenheit (F) to Kelvin (K) = (F - 32)/1.8 + 273.15 Fahrenheit (F) to Celsius (C) = (F - 32)/1.8 Kelvin (K) to Fahrenheit (F) = (K - 273.15) * 9/5 + 32 Kelvin (K) to Celsius (C) = K - 273.15
BAS Module Code
None.

Form Code
Add three text boxes (Text1, Text2, Text3) to a form with the following code:

`Option Explicit`
```''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''```
```'flag to prevent recursive Change events
Dim bInTransaction As Boolean

bInTransaction = True

Text1.Text = "0"
Text2.Text = "0"
Text3.Text = "0"

bInTransaction = False

End Sub

Private Sub Text1_Change()

'bail out if change was fired by
'another routine changing the
'textbox contents
If bInTransaction Then Exit Sub

'validate the entered data
If Len(Text1.Text) > 0 Then
If FieldCheck(Text1) = True Then

'about to update other controls,
'so set the flag and process
bInTransaction = True
Text2.Text = CelsiusToFahrenheit(CSng(Text1.Text))
Text3.Text = CelsiusToKelvin(CSng(Text1.Text))
bInTransaction = False

End If  'If FieldCheck2(Text1)
End If  'If Len(Text1.Text)

End Sub

Private Sub Text2_Change()

If bInTransaction Then Exit Sub

If Len(Text2.Text) > 0 Then
If FieldCheck(Text2) = True Then

bInTransaction = True
Text1.Text = FahrenheitToCelsius(CSng(Text2.Text))
Text3.Text = FahrenheitToKelvin(CSng(Text2.Text))
bInTransaction = False

End If  'If FieldCheck2(Text1)
End If  'If Len(Text1.Text)

End Sub

Private Sub Text3_Change()

If bInTransaction Then Exit Sub

If Len(Text3.Text) > 0 Then
If FieldCheck(Text3) = True Then

bInTransaction = True
Text1.Text = KelvinToCelsius(CSng(Text3.Text))
Text2.Text = KelvinToFahrenheit(CSng(Text3.Text))
bInTransaction = False

End If  'If FieldCheck2(Text1)
End If  'If Len(Text1.Text)

End Sub

Private Function CelsiusToFahrenheit(ByVal temperature As Single) As Single

'Celsius(C) to Fahrenheit(F) = (C * 9/5) + 32
CelsiusToFahrenheit = (temperature * 1.8) + 32

End Function

Private Function KelvinToFahrenheit(ByVal temperature As Single) As Single

'Kelvin(K) to Fahrenheit(F) = (K * 9/5) + 32
KelvinToFahrenheit = ((temperature - 273.15) * 1.8) + 32

End Function

Private Function CelsiusToKelvin(ByVal temperature As Single) As Single

'Celsius(C) to Kelvin(K) = C + 273.15
CelsiusToKelvin = temperature + 273.15

End Function

Private Function FahrenheitToCelsius(ByVal temperature As Single) As Single

'Fahrenheit(F) to Celsius(C) = (F - 32)/1.8
FahrenheitToCelsius = (temperature - 32) / 1.8

'sngValue = (sngValue - 32) / 1.8

End Function

Private Function KelvinToCelsius(ByVal temperature As Single) As Single

'Kelvin(K) to Celsius(C) = K - 273.15
KelvinToCelsius = temperature - 273.15

End Function

Private Function FahrenheitToKelvin(ByVal temperature As Single) As Single

'Fahrenheit(F) to Kelvin(K) = (F - 32)/1.8 + 273.15
FahrenheitToKelvin = ((temperature - 32) / 1.8) + 273.15

End Function

Private Function FieldCheck(txt As TextBox) As Boolean

Const sValidChrs As String = "1234567890."

Dim buff     As String   'string buffer
Dim errmsg   As String   'error msg
Dim bValid   As Boolean  'flag
Dim decimals As Long     'counter var
Dim dashes   As Long     'counter var
Dim commas   As Long     'counter var
Dim cnt      As Long     'counter
Dim char     As String   'char of interest

'setup
bValid = False
decimals = 0
dashes = 0
commas = 0

'retrieve text from the passed control
buff = txt.Text

'see if user entering a negative number
'or decimal, and if so bail if just
'- or . is present
If Len(buff) = 1 And (buff = "-") Or (buff = ".") Then
bValid = False
Exit Function
End If

bValid = True

'loop through the buffer
For cnt = 1 To Len(buff)

'extract a character and validate
char = Mid\$(buff, cnt, 1)
bValid = InStr(sValidChrs, char) > 0

'total up any special characters
decimals = decimals + Abs(char = ".")
dashes = dashes + Abs(char = "-")
commas = commas + Abs(char = ",")

Next cnt

'if the buffer data matches the valid string
'and there are was only 1 decimal and/or dash
'and no commas, then bValid = True
bValid = bValid And _
(decimals <= 1) And _
(dashes <= 1) And _
(commas = 0)

If bValid = False Then

errmsg = "The value entered in " + txt.Name + _
" is not valid. (valid = 1234567890.-)"

If decimals > 1 Then
errmsg = errmsg & vbCrLf & txt.Name + _
" contains more than one decimal."
End If

If dashes > 1 Then
errmsg = errmsg & vbCrLf & txt.Name + _
" contains more than one dash."
End If

If commas > 1 Then
errmsg = errmsg & vbCrLf & txt.Name + _
" cannot contain commas."
End If

If Len(buff) = 0 Then
errmsg = errmsg & vbCrLf & txt.Name + " is empty."
End If

txt.SetFocus
MsgBox errmsg, vbOKOnly Or vbInformation

End If

FieldCheck = bValid

End Function```