|
|
Public Class Form1
'Code by RSPercy 07/10/09
Dim strMyString As String = String.Empty
Dim HI As Long 'Heat Index
Dim AT As Integer 'Air Temperature
Dim RH As Integer 'Relative Humidity
Const C1 As Double = 16.923
Const C2 As Double = 1.85212 * (10 ^ -1) '* AT
Const C3 As Double = 5.37941 '*RH
Const C4 As Double = 1.00254 * (10 ^ -1) '* AT * RH
Const C5 As Double = 9.41695 * (10 ^ -3) '* (AT ^ 2)
Const C6 As Double = 7.28898 * (10 ^ -5) '* (RH ^ 2)
Const C7 As Double = 3.45372 * (10 ^ -4) '* (AT ^ 4) * RH
Const C8 As Double = 8.14971 * (10 ^ -4) '* AT * (RH ^ 2)
Const C9 As Double = 1.02102 * (10 ^ -5) '* (AT ^ 2) * (RH ^ 2)
Const C10 As Double = 3.8646 * (10 ^ -5) '* (AT ^ 3)
Const C11 As Double = 2.91583 * (10 ^ -5) '* (RH ^ 3)
Const C12 As Double = 1.42721 * (10 ^ -6) '* (AT ^ 3) * RH
Const C13 As Double = 1.97483 * (10 ^ -7) '* (AT) * (RH ^ 4)
Const C14 As Double = 2.18429 * (10 ^ -8) '* (AT ^ 3) * (RH ^ 2)
Const C15 As Double = 8.43296 * (10 ^ -10) ' * (AT ^ 2) * (RH ^ 3)
Const C16 As Double = 4.81975 * (10 ^ -11) '* (AT ^ 3) * (RH ^ 3)
'This is the short version
'Const C1 As Double = -42.379
'Const C2 As Double = 2.04901523
'Const C3 As Double = 10.14333147
'Const C4 As Double = 0.22475541
'Const C5 As Double = 6.83783 * (10 ^ -3)
'Const C6 As Double = 5.481717 * (10 ^ -2)
'Const C7 As Double = 1.22874 * (10 ^ -3)
'Const C8 As Double = 8.5282 * (10 ^ -4)
'Const C9 As Double = 1.99 * (10 ^ -6)
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
'Code by RSPercy 07/10/09
Label1.Visible = False
Label2.Visible = False
Label5.Visible = False
Label6.Visible = False
Label9.Visible = False
Label12.Visible = False
Label14.Visible = False
Label16.Visible = False
lblSunRise.Visible = False
lblSunSet.Visible = False
lblVisibility.Visible = False
lblPressure.Visible = False
lblHumidity.Visible = False
btnGo.PerformClick()
End Sub
Private Function GetCondition(ByVal strCondition As String) As String
'Code by RSPercy 07/10/09
Dim t As New YahooWeatherLib.YahooWeatherForecast(txtZip.Text, "f")
Select Case t.rss.channel.item.condition.codeEnum
Case 0
strCondition = "Tornado"
pb1.Image = My.Resources._1
Case 1
strCondition = "Tropical Storm"
pb1.Image = My.Resources._1
Case 2
strCondition = "Hurricane"
pb1.Image = My.Resources._2
Case 3
strCondition = "Severe Thunderstorms"
pb1.Image = My.Resources._3
Case 4
strCondition = "Thunderstorms"
pb1.Image = My.Resources._4
Case 5
strCondition = "Mixed Rain and Snow"
pb1.Image = My.Resources._5
Case 6
strCondition = "Mixed Rain and Sleet"
pb1.Image = My.Resources._6
Case 7
strCondition = "Mixed Snow and Sleet"
pb1.Image = My.Resources._7
Case 8
strCondition = "Freezing Drizzle"
pb1.Image = My.Resources._8
Case 9
strCondition = "Drizzle"
pb1.Image = My.Resources._9
Case 10
strCondition = "Freezing Rain"
pb1.Image = My.Resources._10
Case 11
strCondition = "Showers"
pb1.Image = My.Resources._11
Case 12
strCondition = "Showers"
pb1.Image = My.Resources._12
Case 13
strCondition = "Snow Flurries"
pb1.Image = My.Resources._13
Case 14
strCondition = "Light Snow Showers"
pb1.Image = My.Resources._14
Case 15
strCondition = "Blowing Snow"
pb1.Image = My.Resources._15
Case 16
strCondition = "Snow"
pb1.Image = My.Resources._16
Case 17
strCondition = "Hail"
pb1.Image = My.Resources._17
Case 18
strCondition = "Sleet"
pb1.Image = My.Resources._18
Case 19
strCondition = "Dust"
pb1.Image = My.Resources._19
Case 20
strCondition = "Foggy"
pb1.Image = My.Resources._20
Case 21
strCondition = "Haze"
pb1.Image = My.Resources._21
Case 22
strCondition = "Smoky"
pb1.Image = My.Resources._22
Case 23
strCondition = "Blustery"
pb1.Image = My.Resources._23
Case 24
strCondition = "Windy"
pb1.Image = My.Resources._24
Case 25
strCondition = "Cold"
pb1.Image = My.Resources._25
Case 26
strCondition = "Cloudy"
pb1.Image = My.Resources._26
Case 27
strCondition = "Mostly Cloudy"
pb1.Image = My.Resources._27
Case 28
strCondition = "Mostly Cloudy"
pb1.Image = My.Resources._28
Case 29
strCondition = "Partly Cloudy"
pb1.Image = My.Resources._29
Case 30
strCondition = "Partly Cloudy"
pb1.Image = My.Resources._30
Case 31
strCondition = "Clear Night"
pb1.Image = My.Resources._31
Case 32
strCondition = "Sunny"
pb1.Image = My.Resources._32
Case 33
strCondition = "Fair"
pb1.Image = My.Resources._33
Case 34
strCondition = "Fair"
pb1.Image = My.Resources._34
Case 35
strCondition = "Mixed Rain and Hail"
pb1.Image = My.Resources._35
Case 36
strCondition = "Hot"
pb1.Image = My.Resources._36
Case 37
strCondition = "Isolated Thunderstorms"
pb1.Image = My.Resources._37
Case 38
strCondition = "Scattered Thunderstorms"
pb1.Image = My.Resources._38
Case 39
strCondition = "Scattered Thunderstorms"
pb1.Image = My.Resources._39
Case 40
strCondition = "Scattered Showers"
pb1.Image = My.Resources._40
Case 41
strCondition = "Heavy Snow"
pb1.Image = My.Resources._41
Case 42
strCondition = "Scattered Snow Showers"
pb1.Image = My.Resources._42
Case 43
strCondition = "Heavy Snow"
pb1.Image = My.Resources._43
Case 44
strCondition = "Partly Cloudy"
pb1.Image = My.Resources._44
Case 45
strCondition = "Thundershowers"
pb1.Image = My.Resources._45
Case 46
strCondition = "Snow Showers"
pb1.Image = My.Resources._46
Case 47
strCondition = "Isolated Thundershowers"
pb1.Image = My.Resources._47
Case 3200
strCondition = "Not Available"
pb1.Image = Nothing
End Select
Return strCondition
End Function
Private Sub btnGo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnGo.Click
'Code by RSPercy 07/10/09
Label1.Visible = True
Label2.Visible = True
Label5.Visible = True
Label6.Visible = True
Label9.Visible = True
Label12.Visible = True
Label14.Visible = True
Label16.Visible = True
lblSunRise.Visible = True
lblSunSet.Visible = True
lblVisibility.Visible = True
lblPressure.Visible = True
lblHumidity.Visible = True
Dim t As New YahooWeatherLib.YahooWeatherForecast(txtZip.Text, "f")
Label1.Text = t.rss.channel.item.forecast.high & "�"
Label2.Text = t.rss.channel.item.forecast.low & "�"
Label5.Text = t.rss.channel.item.title
Label6.Text = t.rss.channel.item.condition.temp
AT = CInt(Label6.Text)
Label9.Text = GetCondition(strMyString)
Label12.Text = GetWindDirection(t.rss.channel.wind.direction)
lblHumidity.Text = t.rss.channel.atmosphere.humidity
RH = CInt(lblHumidity.Text)
Label14.Text = RetrieveHeatIndex(HI) & "�"
Label16.Text = t.rss.channel.wind.speed & " mph"
lblSunRise.Text = t.rss.channel.astronomy.sunrise
lblSunSet.Text = t.rss.channel.astronomy.sunset
lblVisibility.Text = t.rss.channel.atmosphere.visibility & " mi."
lblPressure.Text = t.rss.channel.atmosphere.pressure
pbMap.ImageLocation = "http://weather.yahoo.com/images/southeast_sat_440x297.jpg"
lblHumidity.Text += "%"
Label6.Text += "�"
End Sub
Private Function GetWindDirection(ByVal intDirection As Integer) As String
'Code by RSPercy 07/10/09
Dim t As New YahooWeatherLib.YahooWeatherForecast(txtZip.Text, "f")
Dim strWindDirection As String = String.Empty
Select Case t.rss.channel.wind.direction
Case 1 To 11
strWindDirection = "North"
Case 12 To 32
strWindDirection = "N-NE"
Case 33 To 55
strWindDirection = "NE"
Case 56 To 78
strWindDirection = "E-NE"
Case 79 To 101
strWindDirection = "East"
Case 102 To 123
strWindDirection = "E-SE"
Case 124 To 146
strWindDirection = "SE"
Case 147 To 168
strWindDirection = "S-SE"
Case 169 To 191
strWindDirection = "South"
Case 192 To 214
strWindDirection = "S-SW"
Case 215 To 236
strWindDirection = "SW"
Case 237 To 258
strWindDirection = "W-SW"
Case 259 To 281
strWindDirection = "West"
Case 282 To 303
strWindDirection = "W-NW"
Case 304 To 326
strWindDirection = "NW"
Case 327 To 349
strWindDirection = "N-NW"
Case 350 To 360
strWindDirection = "North"
End Select
Return strWindDirection
End Function
Private Sub btnRefresh_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRefresh.Click
btnGo.PerformClick()
End Sub
'Private Function GetHeatIndex(ByVal h As Long) As String
' 'Code by RSPercy 07/10/09
' 'www.crh.noaa.gov/jkl/?n=heat_index_calculator
' 'This is the math algorythym that is at the site above
' 'HI = -42.379 + 2.04901523T + 10.14333127R - 0.22475541TR - 6.83783x(10^-3)(T^2)
' ' - 5.481717x(10^-2)(R^2) + 1.22874x(10^-3)(T^2)(R) + 8.5282x(10^-4)(TR^2 - 1.99x(10^-6)(T^2)(R^2)
' 'T is for the temperature...Label6.Text
' 'R is for the relative Humidity...lblHumidity.Text
' 'All the numbers(doubles) are loaded into Const (C1 - C9) above in the variables section
' Dim HINDX As Long
' HINDX = ((C1 + C2 * CInt(Label6.Text)) + (C3 * CInt(lblHumidity.Text)) - (C4 * CInt(Label6.Text) * CInt(lblHumidity.Text)) - _
' (C5 * CInt(Label6.Text) * CInt(Label6.Text)) - (C6 * CInt(lblHumidity.Text) * CInt(lblHumidity.Text)) + _
' (C7 * CInt(Label6.Text) * CInt(Label6.Text) * CInt(lblHumidity.Text)) + _
' (C8 * CInt(Label6.Text) * CInt(lblHumidity.Text) * CInt(lblHumidity.Text)) - _
' (C9 * (CInt(Label6.Text) * CInt(Label6.Text)) * (CInt(lblHumidity.Text) * CInt(lblHumidity.Text))))
' h = HINDX
' If h < CInt(Label6.Text) Then
' h = CInt(Label6.Text)
' End If
' Return h
'End Function
Private Function RetrieveHeatIndex(ByVal h As Long) As String
'Code by RSPercy 07/11/09
'This is the more advanced version
Dim HEATINDEX As Long
HEATINDEX = C1 + (C2 * AT) + (C3 * RH) - (C4 * AT * RH) + (C5 * (AT ^ 2)) + (C6 * (RH ^ 2)) + _
(C7 * (AT ^ 4) * RH) - (C8 * AT * (RH ^ 2)) + (C9 * (AT ^ 2) * (RH ^ 2)) - (C10 * (AT ^ 3)) + _
(C11 * (RH ^ 3)) + (C12 * (AT ^ 3) * RH) + (C13 * AT * (RH ^ 3)) - (C14 * (AT ^ 3) * (RH ^ 2)) + _
(C15 * (AT ^ 2) * (RH ^ 3)) - (C16 * (AT ^ 3) * (RH ^ 3))
If h < CInt(Label6.Text) Then
h = CInt(Label6.Text)
End If
Return h
End Function
End Class
|
By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.
If a file you wish to view isn't highlighted, and is a text file (not binary), please
let us know and we'll add colourisation support for it.
I am currently retired.
I have no degree but I have some programming experience
when I was in college(Cobol, Pascal).
My accomplishments thus far are;
Best VB.Net article for January(2009)
Best VB.Net article for July(2009)
Submit an article or tip