Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' 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
Private Sub Form_Load()
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 |
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.
