Imports NextUI.Component
Imports NextUI.Frame
Imports NextUI.Collection
Imports System.Collections.Generic
Imports System.Data
Imports System.IO
Imports System.Net
Imports System.ComponentModel
Imports System.Drawing
Imports System.Threading
Imports System.Text.RegularExpressions
Imports System.Text
Imports System.Environment
Imports System.Windows.Forms
Imports YahooWeatherLib.YahooWeatherForecast
Imports System.Runtime.InteropServices
Public Class frmWeather
Inherits Form
'Code by RSPercy 10/22/09
Dim DDcursor As String = GetFolderPath(SpecialFolder.MyDocuments) & "\Cursors\Daffy Duck.cur"
Dim cpCursor As String = GetFolderPath(SpecialFolder.MyDocuments) & "\Cursors\cpcur.cur"
Dim cpCursorOrange As String = GetFolderPath(SpecialFolder.MyDocuments) & "\Cursors\cpcurorange.cur"
Dim cpCamillialien As String = GetFolderPath(SpecialFolder.MyDocuments) & "\Cursors\cpcamilli-alien.cur"
Dim myCapImage As String = GetFolderPath(SpecialFolder.MyPictures) & "\YahooWeatherPics\CapImage.png"
Dim oldTemp As Integer
Dim newTemp As Integer
Dim oldWindD As Integer
Dim newWindD As Integer
Dim oldWindS As Integer
Dim newWindS As Integer
Dim strMyString As String = String.Empty
Dim HI As Long 'Heat Index
Dim AT As Integer 'Air Temperature
Dim RH As Integer 'Relative Humidity
Dim DP As Integer 'Dew Point
Dim strGUID As String = String.Empty
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 ^ -3) '* (RH ^ 2)
Const C7 As Double = 3.45372 * (10 ^ -4) '* (AT ^ 2) * 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 ^ 3)
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)
#Region "Gauges..."
Private Sub CreateWindDirectionGauge()
'Code by RSPercy 10/22/09
Dim t As New YahooWeatherLib.YahooWeatherForecast(txtZip.Text, "f")
Dim f2 As New CircularFrame(New Point(2, 2), 225)
Me.BaseUI2.Frame.Add(f2)
f2.BackRenderer.CenterColor = Color.White
f2.BackRenderer.EndColor = Color.Black
Dim lb As New FrameLabel(New Point((f2.Rect.Width) / 2 - 17, (f2.Rect.Height / 2 + 40)), f2)
Dim lb1 As New FrameLabel(New Point((f2.Rect.Width) / 2 - 15, (f2.Rect.Height / 2 + 50)), f2)
f2.FrameLabelCollection.Add(lb)
f2.FrameLabelCollection.Add(lb1)
lb.LabelFont = New Font(FontFamily.GenericSansSerif, 8, FontStyle.Italic)
lb.FontColor = Color.White
lb.LabelText = "RSPercy"
lb1.LabelFont = New Font(FontFamily.GenericSansSerif, 8, FontStyle.Italic)
lb1.FontColor = Color.White
lb1.LabelText = "Gauges"
Dim bar1 As New CircularScaleBar(f2)
bar1.StartValue = 0
bar1.EndValue = 360
bar1.StartAngle = 270
bar1.SweepAngle = 0
bar1.MajorTickNumber = 16
bar1.MinorTicknumber = 1
bar1.CustomLabel = New String() {"N", "NNE", "NE", "ENE", _
"E", "ESE", "SE", "SSE", _
"S", "SSW", "SW", "WSW", _
"W", "WNW", "NW", "NNW"}
bar1.TickMajor.Width = 3
bar1.TickMajor.Height = 12
bar1.TickMajor.FillColor = Color.Lime
bar1.TickMajor.Type = TickBase.TickType.RoundedRect
bar1.TickMinor.Width = 3
bar1.TickMinor.Height = 8
bar1.TickMinor.FillColor = Color.Lime
bar1.TickMinor.TickPosition = TickBase.Position.Cross
bar1.TickMinor.Type = TickBase.TickType.RoundedRect
bar1.FillColor = Color.DarkBlue
bar1.TickLabel.FontColor = Color.White
bar1.TickLabel.LabelFont = New Font("Elephant", 8, FontStyle.Regular)
bar1.TickLabel.TextDirection = CircularLabel.Direction.Horizontal
f2.ScaleCollection.Add(bar1)
Dim pointer As CircularPointer = New CircularPointer(f2)
bar1.Pointer.Add(pointer)
bar1.Pointer(0).BasePointer.PointerShapeType = Pointerbase.PointerType.Type2
bar1.Pointer(0).BasePointer.FillColor = Color.Blue
bar1.Pointer(0).BasePointer.Length = 90
bar1.Pointer(0).CapPointer.CapImage() = Image.FromFile(myCapImage)
bar1.Pointer(0).CapOnTop = True
bar1.Pointer(0).CapPointer.FillColor = Color.Transparent
bar1.Pointer(0).CapPointer.Diameter = 30
bar1.Pointer(0).Value = oldWindD 't.rss.channel.wind.direction
newWindD = t.rss.channel.wind.direction
Dim nf2 As NumericalFrame = New NumericalFrame(New Rectangle(f2.Rect.Width / 2 - 17, f2.Rect.Height - 175, 30, 20))
nf2.FrameRenderer.FrameWidth = 0
nf2.FrameRenderer.Outline = NextUI.Renderer.FrameRender.FrameOutline.None
Dim a1 As DigitalPanel14Segment = New DigitalPanel14Segment(nf2)
a1.FontThickness = 2
a1.BackColor = Color.Black
a1.MainColor = Color.Lime
Dim a2 As DigitalPanel14Segment = New DigitalPanel14Segment(nf2)
a2.FontThickness = 2
a2.BackColor = Color.Black
a2.MainColor = Color.Lime
Dim a3 As DigitalPanel14Segment = New DigitalPanel14Segment(nf2)
a3.FontThickness = 2
a3.BackColor = Color.Black
a3.MainColor = Color.Lime
nf2.Indicator.Panels.Add(a1)
nf2.Indicator.Panels.Add(a2)
nf2.Indicator.Panels.Add(a3)
f2.FrameCollection.Add(nf2)
'nf2.Indicator.DisplayValue = GetWindDirection(newWindD)
End Sub
Private Sub CreateWindSpeedGauge()
'Code by RSPercy 10/22/09
Dim t As New YahooWeatherLib.YahooWeatherForecast(txtZip.Text, "f")
Dim f3 As New CircularFrame(New Point(2, 2), 225)
Me.BaseUI3.Frame.Add(f3)
f3.BackRenderer.CenterColor = Color.White
f3.BackRenderer.EndColor = Color.Black
Dim lb As New FrameLabel(New Point((f3.Rect.Width) / 2 - 17, (f3.Rect.Height / 2 + 40)), f3)
Dim lb1 As New FrameLabel(New Point((f3.Rect.Width) / 2 - 15, (f3.Rect.Height / 2 + 50)), f3)
f3.FrameLabelCollection.Add(lb)
f3.FrameLabelCollection.Add(lb1)
lb.LabelFont = New Font(FontFamily.GenericSansSerif, 8, FontStyle.Italic)
lb.FontColor = Color.White
lb.LabelText = "RSPercy"
lb1.LabelFont = New Font(FontFamily.GenericSansSerif, 8, FontStyle.Italic)
lb1.FontColor = Color.White
lb1.LabelText = "Gauges"
Dim bar2 As New CircularScaleBar(f3)
bar2.StartValue = 0
bar2.EndValue = 160
bar2.StartAngle = 90
bar2.SweepAngle = 0
bar2.BorderStyle = ScaleBase.Style.NotSet
bar2.TickMinor.TickPosition = TickBase.Position.Cross
bar2.TickMinor.Type = TickBase.TickType.RoundedRect
bar2.TickMajor.Type = TickBase.TickType.RoundedRect
bar2.FillColor = Color.DarkBlue
bar2.TickMajor.Width = 3
bar2.TickMajor.Height = 12
bar2.TickMinor.Width = 3
bar2.TickMinor.Height = 8
bar2.MajorTickNumber = 8
bar2.MinorTicknumber = 3
bar2.CustomLabel = New String() {"0", "20", "40", "60", "80", "100", "120", "140"}
bar2.TickMajor.FillColor = Color.Lime
bar2.TickMinor.FillColor = Color.Lime
bar2.TickLabel.FontColor = Color.White
bar2.TickLabel.LabelFont = New Font("Elephant", 8, FontStyle.Regular)
bar2.TickLabel.TextDirection = CircularLabel.Direction.Horizontal
f3.ScaleCollection.Add(bar2)
Dim pointer As CircularPointer = New CircularPointer(f3)
bar2.Pointer.Add(pointer)
bar2.Pointer(0).BasePointer.PointerShapeType = Pointerbase.PointerType.Type2
bar2.Pointer(0).BasePointer.FillColor = Color.Blue
bar2.Pointer(0).BasePointer.Length = 90
bar2.Pointer(0).CapPointer.CapImage() = Image.FromFile(myCapImage)
bar2.Pointer(0).CapOnTop = True
bar2.Pointer(0).CapPointer.FillColor = Color.Transparent
bar2.Pointer(0).CapPointer.Diameter = 30
bar2.Pointer(0).Value = oldWindS 't.rss.channel.wind.speed
newWindS = t.rss.channel.wind.speed
Dim nf3 As NumericalFrame = New NumericalFrame(New Rectangle(f3.Rect.Width / 2 - 29, f3.Rect.Height - 175, 60, 20))
nf3.FrameRenderer.FrameWidth = 0
nf3.FrameRenderer.Outline = NextUI.Renderer.FrameRender.FrameOutline.None
Dim a1 As DigitalPanel14Segment = New DigitalPanel14Segment(nf3)
a1.FontThickness = 2
a1.BackColor = Color.Black
a1.MainColor = Color.Lime
Dim a2 As DigitalPanel14Segment = New DigitalPanel14Segment(nf3)
a2.FontThickness = 2
a2.BackColor = Color.Black
a2.MainColor = Color.Lime
Dim a3 As DigitalPanel14Segment = New DigitalPanel14Segment(nf3)
a3.FontThickness = 2
a3.BackColor = Color.Black
a3.MainColor = Color.Lime
Dim a4 As DigitalPanel14Segment = New DigitalPanel14Segment(nf3)
a4.FontThickness = 2
a4.BackColor = Color.Black
a4.MainColor = Color.Lime
Dim a5 As DigitalPanel14Segment = New DigitalPanel14Segment(nf3)
a5.FontThickness = 2
a5.BackColor = Color.Black
a5.MainColor = Color.Lime
Dim a6 As DigitalPanel14Segment = New DigitalPanel14Segment(nf3)
a6.FontThickness = 2
a6.BackColor = Color.Black
a6.MainColor = Color.Lime
Dim a7 As DigitalPanel14Segment = New DigitalPanel14Segment(nf3)
a7.FontThickness = 2
a7.BackColor = Color.Black
a7.MainColor = Color.Lime
nf3.Indicator.Panels.Add(a1)
nf3.Indicator.Panels.Add(a2)
nf3.Indicator.Panels.Add(a3)
nf3.Indicator.Panels.Add(a4)
nf3.Indicator.Panels.Add(a5)
nf3.Indicator.Panels.Add(a6)
nf3.Indicator.Panels.Add(a7)
f3.FrameCollection.Add(nf3)
nf3.Indicator.DisplayValue = newWindS.ToString() & " MPH"
If t.rss.channel.wind.speed = 0 Then
nf3.Indicator.DisplayValue = "Calm "
End If
End Sub
Private Sub CreateTempGauge()
'Code by RSPercy 10/22/09
Dim t As New YahooWeatherLib.YahooWeatherForecast(txtZip.Text, "f")
Dim f1 As New CircularFrame(New Point(2, 2), 225)
Me.BaseUI1.Frame.Add(f1)
f1.BackRenderer.CenterColor = Color.White
f1.BackRenderer.EndColor = Color.Black
Dim lb As New FrameLabel(New Point((f1.Rect.Width) / 2 - 17, (f1.Rect.Height / 2 + 40)), f1)
Dim lb1 As New FrameLabel(New Point((f1.Rect.Width) / 2 - 15, (f1.Rect.Height / 2 + 50)), f1)
f1.FrameLabelCollection.Add(lb)
f1.FrameLabelCollection.Add(lb1)
lb.LabelFont = New Font(FontFamily.GenericSansSerif, 8, FontStyle.Italic)
lb.FontColor = Color.White
lb.LabelText = "RSPercy"
lb1.LabelFont = New Font(FontFamily.GenericSansSerif, 8, FontStyle.Italic)
lb1.FontColor = Color.White
lb1.LabelText = "Gauges"
Dim bar1 As New CircularScaleBar(f1)
bar1.StartValue = -60
bar1.EndValue = 120
bar1.StartAngle = 60
bar1.SweepAngle = 55
bar1.MajorTickNumber = 19
bar1.MinorTicknumber = 1
bar1.CustomLabel = New String() {"-60", "-50", "-40", "-30", "-20", _
"-10", "0", "10", "20", "30", _
"40", "50", "60", "70", "80", _
"90", "100", "110", "120"}
bar1.TickMajor.Width = 3
bar1.TickMajor.Height = 12
bar1.TickMajor.FillColor = Color.Lime
bar1.TickMajor.Type = TickBase.TickType.RoundedRect
bar1.TickMinor.Width = 3
bar1.TickMinor.Height = 8
bar1.TickMinor.FillColor = Color.Lime
bar1.TickMinor.TickPosition = TickBase.Position.Cross
bar1.TickMinor.Type = TickBase.TickType.RoundedRect
bar1.FillColor = Color.DarkBlue
bar1.TickLabel.FontColor = Color.White
bar1.TickLabel.LabelFont = New Font("Elephant", 8, FontStyle.Regular)
bar1.TickLabel.TextDirection = CircularLabel.Direction.Horizontal
f1.ScaleCollection.Add(bar1)
Dim pointer As CircularPointer = New CircularPointer(f1)
bar1.Pointer.Add(pointer)
bar1.Pointer(0).BasePointer.PointerShapeType = Pointerbase.PointerType.Type2
bar1.Pointer(0).BasePointer.FillColor = Color.Blue
bar1.Pointer(0).BasePointer.Length = 90
bar1.Pointer(0).CapPointer.CapImage() = Image.FromFile(myCapImage) 'CapType = PointerCapBase.PointerCapType.Type1
bar1.Pointer(0).CapOnTop = True
bar1.Pointer(0).CapPointer.FillColor = Color.Transparent
bar1.Pointer(0).CapPointer.Diameter = 30
bar1.Pointer(0).Value = oldTemp 't.rss.channel.item.condition.temp
newTemp = t.rss.channel.item.condition.temp
Dim nf3 As NumericalFrame = New NumericalFrame(New Rectangle(f1.Rect.Width / 2 - 16, f1.Rect.Height - 175, 30, 20))
nf3.FrameRenderer.FrameWidth = 0
nf3.FrameRenderer.Outline = NextUI.Renderer.FrameRender.FrameOutline.None
Dim a1 As DigitalPanel14Segment = New DigitalPanel14Segment(nf3)
a1.FontThickness = 2
a1.BackColor = Color.Black
a1.MainColor = Color.Lime
Dim a2 As DigitalPanel14Segment = New DigitalPanel14Segment(nf3)
a2.FontThickness = 2
a2.BackColor = Color.Black
a2.MainColor = Color.Lime
Dim a3 As DigitalPanel14Segment = New DigitalPanel14Segment(nf3)
a3.FontThickness = 2
a3.BackColor = Color.Black
a3.MainColor = Color.Lime
Dim a4 As DigitalPanel14Segment = New DigitalPanel14Segment(nf3)
a4.FontThickness = 2
a4.BackColor = Color.Black
a4.MainColor = Color.Lime
nf3.Indicator.Panels.Add(a1)
nf3.Indicator.Panels.Add(a2)
nf3.Indicator.Panels.Add(a3)
nf3.Indicator.Panels.Add(a4)
f1.FrameCollection.Add(nf3)
nf3.Indicator.DisplayValue = newTemp.ToString & "°"
End Sub
#End Region 'Gauges...
#Region "API calls..."
<DllImport("user32.dll")> _
Private Shared Function LoadCursorFromFile(ByVal path As String) As IntPtr
End Function
<DllImport("user32.dll")> _
Private Shared Function SetCursorPos(ByVal x As Integer, ByVal y As Integer) As Boolean
End Function
#End Region 'API Calls...
#Region "Form Subs and Functions..."
Private Sub frmWeather_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
'Code by RSPercy 10/22/09
Try
AddHandler WDTimer.Tick, New EventHandler(AddressOf WDTimer_Tick)
AddHandler WSTimer.Tick, New EventHandler(AddressOf WSTimer_Tick)
AddHandler TMPTimer.Tick, New EventHandler(AddressOf TMPTimer_Tick)
AddHandler timeTimer.Tick, New EventHandler(AddressOf timeTimer_Tick)
AddHandler RichTextBox1.LinkClicked, New LinkClickedEventHandler(AddressOf RichTextBox1_LinkClicked)
Me.Cursor = New Cursor(LoadCursorFromFile(DDcursor))
Dim t As New YahooWeatherLib.YahooWeatherForecast(txtZip.Text, "f")
timeTimer.Enabled = True
oldTemp = 0
newTemp = 0
oldWindD = 0
newWindD = 0
oldWindS = 0
newWindS = 0
GetFiveDates()
btnGo.PerformClick()
pbMap1.ImageLocation = "http://weather.yahoo.com/images/actheat_440x297.jpg"
CreateTempGauge()
CreateWindDirectionGauge()
CreateWindSpeedGauge()
GetAboutInfo()
Catch ex As Exception
MessageBox.Show("Weather is not available for your area..." & vbCrLf & _
"Please try again later!" & vbCrLf & vbCrLf & _
"Application will now Close!", "Info to the Rescue")
Application.Exit()
End Try
SetCursorPos((My.Computer.Screen.WorkingArea.Width - Cursor.Size.Width) / 2,
(My.Computer.Screen.WorkingArea.Height - Cursor.Size.Height) / 2)
End Sub
Private Function RetrieveHeatIndex(ByVal h As Long) As String
'Code by RSPercy 10/22/09
'This is the more advanced version
Dim t As New YahooWeatherLib.YahooWeatherForecast(txtZip.Text, "f")
Dim HEATINDEX As Long
'Heat Index Should be calculated only when air temperatures
'are greater than 80°F (27°C), dew point temperatures are
'greater than 60°F (16°C), and relative humidities are higher than 40%.
HEATINDEX = Math.Round(C1 + (C2 * AT) + (C3 * RH) - (C4 * AT * RH) + (C5 * (AT ^ 2)) + (C6 * (RH ^ 2)) + _
(C7 * (AT ^ 2) * 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)))
h = HEATINDEX
If h < AT Or AT < 80 Then
h = AT
End If
'Wind Chill Should only be calculated when temperatures
'are at or below 50°F and wind speeds are above 3 MPH. Bright
'sunshine may increase the wind chill temperature by 10°F to 18°F.
If AT <= 50 And t.rss.channel.wind.speed > 3 Then
h = t.rss.channel.wind.chill
End If
If AT <= 50 And t.rss.channel.wind.speed <= 3 Then
h = AT
End If
Return h
End Function
Private Function GetCondition(ByVal strCondition As String) As String
'Code by RSPercy 10/22/09
Dim strPath As String = GetFolderPath(SpecialFolder.MyPictures) & "\YahooWeatherPics\"
Dim t As New YahooWeatherLib.YahooWeatherForecast(txtZip.Text, "f")
Select Case t.rss.channel.item.condition.codeEnum
'Retrieve the codeEnum
'Set strCondition to the current weather condition
'Add a pic of the current weather condition
Case 0
strCondition = "Tornado"
pbCondition.ImageLocation = strPath & "1d.png"
Case 1
strCondition = "Tropical Storm"
pbCondition.ImageLocation = strPath & "1d.png"
Case 2
strCondition = "Hurricane"
pbCondition.ImageLocation = strPath & "2d.png"
Case 3
strCondition = "Severe Thunderstorms"
pbCondition.ImageLocation = strPath & "3d.png"
Case 4
strCondition = "Thunderstorms"
pbCondition.ImageLocation = strPath & "4d.png"
Case 5
strCondition = "Mixed Rain and Snow"
pbCondition.ImageLocation = strPath & "5d.png"
Case 6
strCondition = "Mixed Rain and Sleet"
pbCondition.ImageLocation = strPath & "6d.png"
Case 7
strCondition = "Mixed Snow and Sleet"
pbCondition.ImageLocation = strPath & "7d.png"
Case 8
strCondition = "Freezing Drizzle"
pbCondition.ImageLocation = strPath & "8d.png"
Case 9
strCondition = "Drizzle"
pbCondition.ImageLocation = strPath & "9d.png"
Case 10
strCondition = "Freezing Rain"
pbCondition.ImageLocation = strPath & "10d.png"
Case 11
strCondition = "Showers"
pbCondition.ImageLocation = strPath & "11d.png"
Case 12
strCondition = "Showers"
pbCondition.ImageLocation = strPath & "12d.png"
Case 13
strCondition = "Snow Flurries"
pbCondition.ImageLocation = strPath & "13d.png"
Case 14
strCondition = "Light Snow Showers"
pbCondition.ImageLocation = strPath & "14d.png"
Case 15
strCondition = "Blowing Snow"
pbCondition.ImageLocation = strPath & "15d.png"
Case 16
strCondition = "Snow"
pbCondition.ImageLocation = strPath & "16d.png"
Case 17
strCondition = "Hail"
pbCondition.ImageLocation = strPath & "17d.png"
Case 18
strCondition = "Sleet"
pbCondition.ImageLocation = strPath & "18d.png"
Case 19
strCondition = "Dust"
If lblDay1.Text = "Today" Then
pbCondition.ImageLocation = strPath & "19d.png"
Else
pbCondition.ImageLocation = strPath & "19n.png"
End If
Case 20
strCondition = "Foggy"
pbCondition.ImageLocation = strPath & "20d.png"
Case 21
strCondition = "Haze"
If lblDay1.Text = "Today" Then
pbCondition.ImageLocation = strPath & "21d.png"
Else
pbCondition.ImageLocation = strPath & "21n.png"
End If
Case 22
strCondition = "Smoky"
If lblDay1.Text = "Today" Then
pbCondition.ImageLocation = strPath & "22d.png"
Else
pbCondition.ImageLocation = strPath & "22n.png"
End If
Case 23
strCondition = "Blustery"
pbCondition.ImageLocation = strPath & "23d.png"
Case 24
strCondition = "Windy"
pbCondition.ImageLocation = strPath & "24d.png"
Case 25
strCondition = "Cold"
pbCondition.ImageLocation = strPath & "25d.png"
Case 26
strCondition = "Cloudy"
pbCondition.ImageLocation = strPath & "26d.png"
Case 27
strCondition = "Mostly Cloudy" 'Night
pbCondition.ImageLocation = strPath & "27n.png"
Case 28
strCondition = "Mostly Cloudy"
pbCondition.ImageLocation = strPath & "28d.png"
Case 29
strCondition = "Partly Cloudy" 'Night
pbCondition.ImageLocation = strPath & "29n.png"
Case 30
strCondition = "Partly Cloudy"
pbCondition.ImageLocation = strPath & "30d.png"
Case 31
strCondition = "Clear Night"
pbCondition.ImageLocation = strPath & "31n.png"
Case 32
strCondition = "Sunny"
pbCondition.ImageLocation = strPath & "32d.png"
Case 33
strCondition = "Fair" 'Night
pbCondition.ImageLocation = strPath & "33n.png"
Case 34
strCondition = "Fair"
pbCondition.ImageLocation = strPath & "33d.png"
Case 35
strCondition = "Mixed Rain and Hail"
pbCondition.ImageLocation = strPath & "35d.png"
Case 36
strCondition = "Hot"
pbCondition.ImageLocation = strPath & "36d.png"
Case 37
strCondition = "Isolated Thunderstorms"
pbCondition.ImageLocation = strPath & "37d.png"
Case 38
strCondition = "Scattered Thunderstorms" 'Light
pbCondition.ImageLocation = strPath & "38d.png"
Case 39
strCondition = "Scattered Thunderstorms" 'Heavy
pbCondition.ImageLocation = strPath & "39d.png"
Case 40
strCondition = "Scattered Showers"
pbCondition.ImageLocation = strPath & "40d.png"
Case 41
strCondition = "Heavy Snow"
pbCondition.ImageLocation = strPath & "41d.png"
Case 42
strCondition = "Scattered Snow Showers"
pbCondition.ImageLocation = strPath & "42d.png"
Case 43
strCondition = "Heavy Snow"
pbCondition.ImageLocation = strPath & "43d.png"
Case 44
strCondition = "Partly Cloudy"
pbCondition.ImageLocation = strPath & "30d.png"
Case 45
strCondition = "Thundershowers" 'Night
pbCondition.ImageLocation = strPath & "45d.png"
Case 46
strCondition = "Snow Showers" 'Night
pbCondition.ImageLocation = strPath & "46d.png"
Case 47
strCondition = "Isolated Thundershowers" 'Night
pbCondition.ImageLocation = strPath & "47d.png"
Case 3200
strCondition = "Not Available"
pbCondition.ImageLocation = strPath & "44d.png"
End Select
Return strCondition
End Function
Private Sub RetrieveZipCode()
'Code by RSPercy 10/22/09
Dim MZ As Integer = CInt(txtZip.Text)
Try
Select Case MZ 'American Zip-Codes
Case 501, 544, 1001 To 5907, 6001 To 6928, 7001 To 8989, _
10001 To 14925, 15001 To 19612, 46001 To 47997, 48001 To 49971
'pbMap2.ImageLocation = "http://weather.yahoo.com/images/northeast_sat_440x297.jpg"
pbMap.ImageLocation = "http://weather.yahoo.com/images/us_ne_9regradar_medium_usen.jpg"
'pbMap3.ImageLocation = "http://weather.yahoo.com/images/na_unitedstates_ne_outlookf_en_US_440_mdy_y.jpg"
Case 29001 To 29945, 30002 To 31999, 32003 To 34997, 35004 To 36925, 38601 To 39776, 39813 To 39901
'pbMap2.ImageLocation = "http://weather.yahoo.com/images/southeast_sat_440x297.jpg"
pbMap.ImageLocation = "http://weather.yahoo.com/images/us_se_9regradar_medium_usen.jpg"
'pbMap3.ImageLocation = "http://weather.yahoo.com/images/na_unitedstates_se_outlookf_en_US_440_mdy_y.jpg"
Case 19701 To 19980, 20101 To 20587, 20588 To 21930, 22001 To 24658, 24701 To 26886, _
27006 To 28909, 37010 To 38589, 40003 To 42788, 43001 To 45999
'pbMap2.ImageLocation = "http://weather.yahoo.com/images/east_cen_sat_440x297.jpg"
pbMap.ImageLocation = "http://weather.yahoo.com/images/us_ec_9regradar_medium_usen.jpg"
'pbMap3.ImageLocation = "http://weather.yahoo.com/images/na_unitedstates_ec_outlookf_en_US_440_mdy_y.jpg"
Case 70001 To 71497, 71601 To 72959, 73001 To 73198, 73301, 73344, 73401 To 74960, _
75001 To 76958, 77001 To 79999, 88510 To 88595
'pbMap2.ImageLocation = "http://weather.yahoo.com/images/s_central_sat_440x297.jpg"
pbMap.ImageLocation = "http://weather.yahoo.com/images/us_sc_9regradar_medium_usen.jpg"
'pbMap3.ImageLocation = "http://weather.yahoo.com/images/na_unitedstates_sc_outlookf_en_US_440_mdy_y.jpg"
Case 60001 To 62999, 63001 To 65899, 66002 To 66211
'pbMap2.ImageLocation = "http://weather.yahoo.com/images/central_sat_440x297.jpg"
pbMap.ImageLocation = "http://weather.yahoo.com/images/us_cn_9regradar_medium_usen.jpg"
'pbMap3.ImageLocation = "http://weather.yahoo.com/images/na_unitedstates_cn_outlookf_en_US_440_mdy_y.jpg"
Case 50001 To 52809, 53001 To 54990, 55001 To 56763, 57001 To 57799, 58001 To 58856, 68001 To 69367
'pbMap2.ImageLocation = "http://weather.yahoo.com/images/n_central_sat_440x297.jpg"
pbMap.ImageLocation = "http://weather.yahoo.com/images/us_nc_9regradar_medium_usen.jpg"
'pbMap3.ImageLocation = "http://weather.yahoo.com/images/na_unitedstates_nc_outlookf_en_US_440_mdy_y.jpg"
Case 59001 To 59937, 83201 To 83887, 97001 To 97920, 98001 To 99403
'pbMap2.ImageLocation = "http://weather.yahoo.com/images/northwest_sat_440x297.jpg"
pbMap.ImageLocation = "http://weather.yahoo.com/images/us_nw_9regradar_medium_usen.jpg"
'pbMap3.ImageLocation = "http://weather.yahoo.com/images/na_unitedstates_nw_outlookf_en_US_440_mdy_y.jpg"
Case 80001 To 81658, 82001 To 82010, 82050 To 82084, 82190, 82201, _
82210 To 82244, 82301 To 83128, 83414, 84001 To 84791, 88901 To 89883, 90001 To 96162
'pbMap2.ImageLocation = "http://weather.yahoo.com/images/west_cen_sat_440x297.jpg"
pbMap.ImageLocation = "http://weather.yahoo.com/images/us_wc_9regradar_medium_usen.jpg"
'pbMap3.ImageLocation = "http://weather.yahoo.com/images/na_unitedstates_wc_outlookf_en_US_440_mdy_y.jpg"
Case 85001 To 85087, 85097 To 85099, 85201 To 85312, 85318, 85320 To 85396, 85501, 85502, _
85530 To 85554, 85601 To 85655, 85658, 85662 To 86556, 87001 To 88439
'pbMap2.ImageLocation = "http://weather.yahoo.com/images/southwest_sat_440x297.jpg"
pbMap.ImageLocation = "http://weather.yahoo.com/images/us_sw_9regradar_medium_usen.jpg"
'pbMap3.ImageLocation = "http://weather.yahoo.com/images/na_unitedstates_sw_outlookf_en_US_440_mdy_y.jpg"
Case 96701 To 96898
'pbMap2.ImageLocation = "http://weather.yahoo.com/images/hisat_440x297.jpg"
pbMap.ImageLocation = "http://weather.yahoo.com/images/us_hawaii_radar_medium_usen.jpg"
'pbMap3.ImageLocation = ""
Case 99501 To 99950
'pbMap2.ImageLocation = "http://weather.yahoo.com/images/aksat_440x297.jpg"
pbMap.ImageLocation = "http://weather.yahoo.com/images/us_alaska_radar_medium_usen.jpg"
'pbMap3.ImageLocation = ""
Case Else
MessageBox.Show("Please Enter a Valid Zip-Code.")
End Select
Catch ex As System.NullReferenceException
MessageBox.Show(ex.Message & "Please Enter a Valid Zip-Code.", "Info to the Rescue")
txtZip.Focus()
End Try
End Sub
Private Function GetDewPoint(ByVal intRH As Integer) As Integer
'Code by RSPercy 10/22/09
Dim dewpoint As Integer
Select Case intRH
Case 50 To 52
dewpoint = AT - 15
Case 53 To 55
dewpoint = AT - 14
Case 56 To 59
dewpoint = AT - 13
Case 60 To 63
dewpoint = AT - 12
Case 64 To 66
dewpoint = AT - 11
Case 67 To 69
dewpoint = AT - 10
Case 70 To 72
dewpoint = AT - 9
Case 73 To 76
dewpoint = AT - 8
Case 77 To 79
dewpoint = AT - 7
Case 80 To 82
dewpoint = AT - 6
Case 83 To 85
dewpoint = AT - 5
Case 86 To 89
dewpoint = AT - 4
Case 90 To 93
dewpoint = AT - 3
Case 94 To 96
dewpoint = AT - 2
Case 97 To 99
dewpoint = AT - 1
Case 100
dewpoint = AT
Case Else
dewpoint = Math.Round(AT - ((100 - RH) / 5))
End Select
Return dewpoint
End Function
Private Sub btnGo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnGo.Click
'Code by RSPercy 10/22/09
Try
Dim t As New YahooWeatherLib.YahooWeatherForecast(txtZip.Text, "f") 't = all the goodies
lblLocation.Text = t.rss.channel.item.title 'Display the Title
lblHigh.Text = t.rss.channel.item.forecast.high & "°" 'High temperature
lblLow.Text = t.rss.channel.item.forecast.low & "°" 'Low tempeerature
newWindD = t.rss.channel.wind.direction
newWindS = t.rss.channel.wind.speed
newTemp = t.rss.channel.item.condition.temp 'Current temperature
AT = newTemp 'A variable used in RetrieveHeatIndex
Get2DayForecast()
GetFiveDayInfo()
lblCondition.Text = GetCondition(strMyString) 'Current Weather Condition
lblHumidity.Text = t.rss.channel.atmosphere.humidity 'Humidity percentage
RH = CInt(lblHumidity.Text) 'A variable used in RetrieveHeatIndex
lblHeatIndex.Text = RetrieveHeatIndex(HI) & "°" 'Heat Index
lblSunrise.Text = t.rss.channel.astronomy.sunrise 'Sunrise
lblSunset.Text = t.rss.channel.astronomy.sunset 'Sunset
lblVisibility.Text = t.rss.channel.atmosphere.visibility & " mi." 'Visibility
If t.rss.channel.atmosphere.rising = 0 Then
lblPressure.Text = t.rss.channel.atmosphere.pressure & " " & _
"in and steady"
ElseIf t.rss.channel.atmosphere.rising = 1 Then
lblPressure.Text = t.rss.channel.atmosphere.pressure & " " & _
"in and rising"
ElseIf t.rss.channel.atmosphere.rising = 2 Then
lblPressure.Text = t.rss.channel.atmosphere.pressure & " " & _
"in and falling"
End If
lblDewPoint.Text = GetDewPoint(RH).ToString() & "°"
RetrieveZipCode() 'Gets the zip-code and displays the correct doppler map
lblHumidity.Text += "%"
lblTemp.Text = newTemp.ToString & "°"
lblDate.Text = FormatDateTime(Now.Date, DateFormat.ShortDate)
WDTimer.Enabled = True
WSTimer.Enabled = True
TMPTimer.Enabled = True
'MessageBox.Show(t.rss.channel.item.guid)
Catch ex As System.NullReferenceException
MessageBox.Show("Please Enter a Valid Zip-Code.", "Info to the Rescue")
txtZip.Focus()
Catch 'exs As IOException
MessageBox.Show("Please Try Again Later. Weather is Not Available.", "Info to the Rescue")
txtZip.Focus()
End Try
End Sub
Private Sub GetAboutInfo()
'Code by RSPercy 10/22/09
Me.LabelProductName.Text = My.Application.Info.ProductName
Me.LabelVersion.Text = String.Format("Version {0}", My.Application.Info.Version.ToString)
Me.LabelCopyright.Text = My.Application.Info.Copyright
Me.LabelCompanyName.Text = My.Application.Info.CompanyName
Me.TextBoxDescription.Text = My.Application.Info.Description
End Sub
Private Sub RichTextBox1_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkClickedEventArgs) Handles RichTextBox1.LinkClicked
'Code by RSPercy 10/22/09
Process.Start(e.LinkText)
End Sub
#End Region 'Form Subs and Functions...
#Region "All timer events..."
Private Sub timeTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles timeTimer.Tick
'Code by RSPercy 10/22/09
lblTime.Text = FormatDateTime(Now, DateFormat.LongTime).ToString
End Sub
Private Sub TMPTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TMPTimer.Tick
'Code by RSPercy 10/22/09
If oldTemp < newTemp Then
oldTemp += 1
DirectCast((Me.BaseUI1.Frame(0)), CircularFrame).ScaleCollection(0).Pointer(0).Value = oldTemp
DirectCast(Me.BaseUI1.Frame(0).FrameCollection(0), NumericalFrame).Indicator.DisplayValue = oldTemp.ToString() & "°"
If oldTemp = newTemp Then
oldTemp = newTemp
TMPTimer.Enabled = False
End If
End If
If oldTemp > newTemp Then
oldTemp -= 1
DirectCast((Me.BaseUI1.Frame(0)), CircularFrame).ScaleCollection(0).Pointer(0).Value = oldTemp
DirectCast(Me.BaseUI1.Frame(0).FrameCollection(0), NumericalFrame).Indicator.DisplayValue = oldTemp.ToString() & "°"
If oldTemp = newTemp Then
oldTemp = newTemp
TMPTimer.Enabled = False
End If
End If
End Sub
Private Sub WDTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles WDTimer.Tick
'Code by RSPercy 10/22/09
If oldWindD < newWindD Then
oldWindD += 1
DirectCast((Me.BaseUI2.Frame(0)), CircularFrame).ScaleCollection(0).Pointer(0).Value = oldWindD
DirectCast(Me.BaseUI2.Frame(0).FrameCollection(0), NumericalFrame).Indicator.DisplayValue = oldWindD
If oldWindD = newWindD Then
oldWindD = newWindD
WDTimer.Enabled = False
End If
End If
If oldWindD > newWindD Then
oldWindD -= 1
DirectCast((Me.BaseUI2.Frame(0)), CircularFrame).ScaleCollection(0).Pointer(0).Value = oldWindD
DirectCast(Me.BaseUI2.Frame(0).FrameCollection(0), NumericalFrame).Indicator.DisplayValue = oldWindD
If oldWindD = newWindD Then
oldWindD = newWindD
WDTimer.Enabled = False
End If
End If
End Sub
Private Sub WSTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles WSTimer.Tick
'Code by RSPercy 10/22/09
If oldWindS < newWindS Then
oldWindS += 1
DirectCast((Me.BaseUI3.Frame(0)), CircularFrame).ScaleCollection(0).Pointer(0).Value = oldWindS
DirectCast(Me.BaseUI3.Frame(0).FrameCollection(0), NumericalFrame).Indicator.DisplayValue = oldWindS.ToString() & " MPH"
If oldWindS = newWindS Then
oldWindS = newWindS
WSTimer.Enabled = False
End If
End If
If oldWindS > newWindS Then
oldWindS -= 1
DirectCast((Me.BaseUI3.Frame(0)), CircularFrame).ScaleCollection(0).Pointer(0).Value = oldWindS
DirectCast(Me.BaseUI3.Frame(0).FrameCollection(0), NumericalFrame).Indicator.DisplayValue = oldWindS.ToString() & " MPH"
If oldWindS = newWindS Then
oldWindS = newWindS
WSTimer.Enabled = False
End If
End If
If oldWindS = 0 Then
DirectCast(Me.BaseUI3.Frame(0).FrameCollection(0), NumericalFrame).Indicator.DisplayValue = "Calm "
End If
End Sub
#End Region 'All timer events...
#Region "The 2-Day Forecast..."
Private Sub Get2DayForecast()
'Code by RSPercy 10/22/09
Try
Dim parts() As String
Dim m As Match
Dim strMatch As String = String.Empty
Dim t As New YahooWeatherLib.YahooWeatherForecast(txtZip.Text, "f")
'''''''''''''''''''''''''''Day, Condition, High, Low
Dim pattern As String = "\w*\s-\s(\w*|\w*\s\w*|\w*\s\w*\s\w*|\w*\s\w*\s\w*\s\w*|\w*\/\w*|\w*\s\w*\/\w*\s\w*)\.\s\w*:\s\d{1,3}\s\w*:\s\d{1,3}"
Dim input As String = t.rss.channel.item.description
For Each m In Regex.Matches(input, pattern, RegexOptions.Multiline)
strMatch = m.Value
If strMatch = Nothing Then
Exit For
Else
strMatch = strMatch.Replace(" - ", ",")
strMatch = strMatch.Replace(". High: ", ",")
strMatch = strMatch.Replace(" Low: ", ",")
'MessageBox.Show(strMatch) 'For testing ONLY
parts = Split(strMatch, ",")
If parts(0) <> t.rss.channel.item.forecast.day Then
lblTomorrow.Text = parts(0)
lblcc2.Text = parts(1)
RetrieveForecastCode()
lblHigh2.Text = "High: " & parts(2)
lblLow2.Text = "Low : " & parts(3)
ElseIf parts(0) = t.rss.channel.item.forecast.day Then
lblcc1.Text = parts(1)
RetrieveForecast1()
lblHigh1.Text = "High: " & parts(2)
lblLow1.Text = "Low : " & parts(3)
End If
End If
Next
Catch ex As Exception
MessageBox.Show("Sorry...Try again later!", "Info to the Rescue!")
End Try
End Sub
Private Sub RetrieveForecastCode()
'Code by RSPercy 10/22/09
Dim strPath As String = GetFolderPath(SpecialFolder.MyPictures) & "\YahooWeatherPics\"
Dim t As New YahooWeatherLib.YahooWeatherForecast(txtZip.Text, "f")
'Retrieve the condition for Tomorrows forecast and
'Add a pic of the current weather condition
If Trim(lblcc2.Text) = "Tornado" Then
picSmall2.ImageLocation = strPath & "1d.png"
ElseIf Trim(lblcc2.Text) = "Tropical Storm" Then
picSmall2.ImageLocation = strPath & "1d.png"
ElseIf Trim(lblcc2.Text) = "Hurricane" Then
picSmall2.ImageLocation = strPath & "2d.png"
ElseIf Trim(lblcc2.Text) = "Severe Thunderstorms" Then
picSmall2.ImageLocation = strPath & "3d.png"
ElseIf Trim(lblcc2.Text) = "Thunderstorms" Then
picSmall2.ImageLocation = strPath & "4d.png"
ElseIf Trim(lblcc2.Text) = "Mixed Rain and Snow" Then
picSmall2.ImageLocation = strPath & "5d.png"
ElseIf Trim(lblcc1.Text) = "Mixed Rain and Sleet" Then
picSmall2.ImageLocation = strPath & "6d.png"
ElseIf Trim(lblcc2.Text) = "Freezing Drizzle" Then
picSmall2.ImageLocation = strPath & "8d.png"
ElseIf Trim(lblcc2.Text) = "Drizzle" Then
picSmall2.ImageLocation = strPath & "9d.png"
ElseIf Trim(lblcc2.Text) = "AM Drizzle" Then
picSmall2.ImageLocation = strPath & "9d.png"
ElseIf Trim(lblcc2.Text) = "PM Drizzle" Then
picSmall2.ImageLocation = strPath & "9d.png"
ElseIf Trim(lblcc2.Text) = "Drizzle Early" Then
picSmall2.ImageLocation = strPath & "9d.png"
ElseIf Trim(lblcc2.Text) = "Drizzle Late" Then
picSmall2.ImageLocation = strPath & "9d.png"
ElseIf Trim(lblcc2.Text) = "Freezing Rain" Then
picSmall2.ImageLocation = strPath & "10d.png"
ElseIf Trim(lblcc2.Text) = "Showers" Then
picSmall2.ImageLocation = strPath & "11d.png"
ElseIf Trim(lblcc2.Text) = "Snow Flurries" Then
picSmall2.ImageLocation = strPath & "13d.png"
ElseIf Trim(lblcc2.Text) = "Light Snow Showers" Then
picSmall2.ImageLocation = strPath & "14d.png"
ElseIf Trim(lblcc2.Text) = "Blowing Snow" Then
picSmall2.ImageLocation = strPath & "15d.png"
ElseIf Trim(lblcc2.Text) = "Snow" Then
picSmall2.ImageLocation = strPath & "16d.png"
ElseIf Trim(lblcc2.Text) = "Hail" Then
picSmall2.ImageLocation = strPath & "17d.png"
ElseIf Trim(lblcc2.Text) = "Sleet" Then
picSmall2.ImageLocation = strPath & "18d.png"
ElseIf Trim(lblcc2.Text) = "Dust" And lblDay1.Text = "Today" Then
picSmall2.ImageLocation = strPath & "19d.png"
ElseIf Trim(lblcc2.Text) = "Dust" And lblDay1.Text = "Tonight" Then
picSmall2.ImageLocation = strPath & "19n.png"
ElseIf Trim(lblcc2.Text) = "Foggy" Then
picSmall2.ImageLocation = strPath & "20d.png"
ElseIf Trim(lblcc2.Text) = "Haze" And lblDay1.Text = "Today" Then
picSmall2.ImageLocation = strPath & "21d.png"
ElseIf Trim(lblcc2.Text) = "Haze" And lblDay1.Text = "Tonight" Then
picSmall2.ImageLocation = strPath & "21n.png"
ElseIf Trim(lblcc2.Text) = "Smoky" And lblDay1.Text = "Today" Then
picSmall2.ImageLocation = strPath & "22d.png"
ElseIf Trim(lblcc2.Text) = "Smoky" And lblDay1.Text = "Tonight" Then
picSmall2.ImageLocation = strPath & "22n.png"
ElseIf Trim(lblcc2.Text) = "Blustery" Then
picSmall2.ImageLocation = strPath & "23d.png"
ElseIf Trim(lblcc2.Text) = "Windy" Then
picSmall2.ImageLocation = strPath & "24d.png"
ElseIf Trim(lblcc2.Text) = "Cold" Then
picSmall2.ImageLocation = strPath & "25d.png"
ElseIf Trim(lblcc2.Text) = "Cloudy" Then
picSmall2.ImageLocation = strPath & "26d.png"
ElseIf Trim(lblcc2.Text) = "Mostly Cloudy" Then
picSmall2.ImageLocation = strPath & "28d.png"
ElseIf Trim(lblcc2.Text) = "Partly Cloudy" Then
picSmall2.ImageLocation = strPath & "30d.png"
ElseIf Trim(lblcc2.Text) = "Clouds Late/Clearing Early" Then
picSmall2.ImageLocation = strPath & "26d.png"
ElseIf Trim(lblcc2.Text) = "Clouds Early/Clearing Late" Then
picSmall2.ImageLocation = strPath & "26d.png"
ElseIf Trim(lblcc2.Text) = "Clear" Then
picSmall2.ImageLocation = strPath & "31d.png"
ElseIf Trim(lblcc2.Text) = "Mostly Clear" Then
picSmall2.ImageLocation = strPath & "31d.png"
ElseIf Trim(lblcc2.Text) = "PM Clear" Then
picSmall2.ImageLocation = strPath & "31n.png"
ElseIf Trim(lblcc2.Text) = "AM Clear" Then
picSmall2.ImageLocation = strPath & "31d.png"
ElseIf Trim(lblcc2.Text) = "Mostly Sunny" Then
picSmall2.ImageLocation = strPath & "32d.png"
ElseIf Trim(lblcc2.Text) = "Sunny" Then
picSmall2.ImageLocation = strPath & "32d.png"
ElseIf Trim(lblcc2.Text) = "Fair" Then
picSmall2.ImageLocation = strPath & "33d.png"
ElseIf Trim(lblcc2.Text) = "Mixed Rain and Hail" Then
picSmall2.ImageLocation = strPath & "35d.png"
ElseIf Trim(lblcc2.Text) = "Hot" Then
picSmall2.ImageLocation = strPath & "36d.png"
ElseIf Trim(lblcc2.Text) = "Isolated Thunderstorms" Then
picSmall2.ImageLocation = strPath & "37d.png"
ElseIf Trim(lblcc2.Text) = "Scattered Thunderstorms" Then
picSmall2.ImageLocation = strPath & "38d.png"
ElseIf Trim(lblcc2.Text) = "PM Thunderstorms" Then
picSmall2.ImageLocation = strPath & "38n.png"
ElseIf Trim(lblcc2.Text) = "Thunderstorms Late" Then
picSmall2.ImageLocation = strPath & "38n.png"
ElseIf Trim(lblcc2.Text) = "AM Thunderstorms" Then
picSmall2.ImageLocation = strPath & "38d.png"
ElseIf Trim(lblcc2.Text) = "Thunderstorms Early" Then
picSmall2.ImageLocation = strPath & "38d.png"
ElseIf Trim(lblcc2.Text) = "PM Showers" Then
picSmall2.ImageLocation = strPath & "39n.png"
ElseIf Trim(lblcc2.Text) = "Showers Late" Then
picSmall2.ImageLocation = strPath & "39n.png"
ElseIf Trim(lblcc2.Text) = "AM Showers" Then
picSmall2.ImageLocation = strPath & "39d.png"
ElseIf Trim(lblcc2.Text) = "Showers Early" Then
picSmall2.ImageLocation = strPath & "39d.png"
ElseIf Trim(lblcc2.Text) = "Showers Late" Then
picSmall2.ImageLocation = strPath & "39n.png"
ElseIf Trim(lblcc2.Text) = "Few Showers" Then
picSmall2.ImageLocation = strPath & "39d.png"
ElseIf Trim(lblcc2.Text) = "Light Rain" Then
picSmall2.ImageLocation = strPath & "9d.png"
ElseIf Trim(lblcc2.Text) = "Rain Early" Then
picSmall2.ImageLocation = strPath & "9d.png"
ElseIf Trim(lblcc2.Text) = "Rain" Then
picSmall2.ImageLocation = strPath & "9d.png"
ElseIf Trim(lblcc2.Text) = "Scattered Showers" Then
picSmall2.ImageLocation = strPath & "40d.png"
ElseIf Trim(lblcc2.Text) = "Heavy Snow" Then
picSmall2.ImageLocation = strPath & "41d.png"
ElseIf Trim(lblcc2.Text) = "Scattered Snow Showers" Then
picSmall2.ImageLocation = strPath & "42d.png"
'Case "heavy snow"
' picSmall2.ImageLocation = strPath & "43d.png"
'Case "44"
' picSmall2.ImageLocation = strPath & "30d.png"
ElseIf Trim(lblcc2.Text) = "Thundershowers" Then
picSmall2.ImageLocation = strPath & "45d.png"
ElseIf Trim(lblcc2.Text) = "Snow Showers" Then
picSmall2.ImageLocation = strPath & "46d.png"
ElseIf Trim(lblcc2.Text) = "Isolated Thundershowers" Then
picSmall2.ImageLocation = strPath & "47d.png"
ElseIf Trim(lblcc2.Text) = "AM Thundershowers" Then
picSmall2.ImageLocation = strPath & "47d.png"
ElseIf Trim(lblcc2.Text) = "PM Thundershowers" Then
picSmall2.ImageLocation = strPath & "47n.png"
ElseIf Trim(lblcc2.Text) = "Rain/Thunder" Then
picSmall2.ImageLocation = strPath & "8d.png"
ElseIf Trim(lblcc2.Text) = "AM Clouds/PM Sun" Then
picSmall2.ImageLocation = strPath & "30d.png"
ElseIf Trim(lblcc2.Text) = "AM Sun/PM Clouds" Then
picSmall2.ImageLocation = strPath & "30d.png"
ElseIf Trim(lblcc2.Text) = "" Then
lblcc2.Text = "Not Available"
picSmall2.ImageLocation = strPath & "44d.png"
End If
End Sub
Private Sub RetrieveForecast1()
'Code by RSPercy 10/22/09
Dim strPath As String = GetFolderPath(SpecialFolder.MyPictures) & "\YahooWeatherPics\"
Dim t As New YahooWeatherLib.YahooWeatherForecast(txtZip.Text, "f")
'Retrieve the condition for Todays forecast and
'Add a pic of the current weather condition
If Trim(lblcc1.Text) = "Tornado" Then
picSmall1.ImageLocation = strPath & "1d.png"
ElseIf Trim(lblcc1.Text) = "Tropical Storm" Then
picSmall1.ImageLocation = strPath & "1d.png"
ElseIf Trim(lblcc1.Text) = "Hurricane" Then
picSmall1.ImageLocation = strPath & "2d.png"
ElseIf Trim(lblcc1.Text) = "Severe Thunderstorms" Then
picSmall1.ImageLocation = strPath & "3d.png"
ElseIf Trim(lblcc1.Text) = "Thunderstorms" Then
picSmall1.ImageLocation = strPath & "4d.png"
ElseIf Trim(lblcc1.Text) = "Mixed Rain and Snow" Then
picSmall1.ImageLocation = strPath & "5d.png"
ElseIf Trim(lblcc1.Text) = "Mixed Rain and Sleet" Then
picSmall1.ImageLocation = strPath & "6d.png"
ElseIf Trim(lblcc1.Text) = "Mixed Snow and Sleet" Then
picSmall1.ImageLocation = strPath & "7d.png"
ElseIf Trim(lblcc1.Text) = "Freezing Drizzle" Then
picSmall1.ImageLocation = strPath & "8d.png"
ElseIf Trim(lblcc1.Text) = "Drizzle" Then
picSmall1.ImageLocation = strPath & "9d.png"
ElseIf Trim(lblcc1.Text) = "AM Drizzle" Then
picSmall1.ImageLocation = strPath & "9d.png"
ElseIf Trim(lblcc1.Text) = "PM Drizzle" Then
picSmall1.ImageLocation = strPath & "9d.png"
ElseIf Trim(lblcc1.Text) = "Drizzle Early" Then
picSmall1.ImageLocation = strPath & "9d.png"
ElseIf Trim(lblcc1.Text) = "Drizzle Late" Then
picSmall1.ImageLocation = strPath & "9d.png"
ElseIf Trim(lblcc1.Text) = "Freezing Rain" Then
picSmall1.ImageLocation = strPath & "10d.png"
ElseIf Trim(lblcc1.Text) = "Showers" Then
picSmall1.ImageLocation = strPath & "11d.png"
ElseIf Trim(lblcc1.Text) = "Snow Flurries" Then
picSmall1.ImageLocation = strPath & "13d.png"
ElseIf Trim(lblcc1.Text) = "Light Snow Showers" Then
picSmall1.ImageLocation = strPath & "14d.png"
ElseIf Trim(lblcc1.Text) = "Blowing Snow" Then
picSmall1.ImageLocation = strPath & "15d.png"
ElseIf Trim(lblcc1.Text) = "Snow" Then
picSmall1.ImageLocation = strPath & "16d.png"
ElseIf Trim(lblcc1.Text) = "Hail" Then
picSmall1.ImageLocation = strPath & "17d.png"
ElseIf Trim(lblcc1.Text) = "Sleet" Then
picSmall1.ImageLocation = strPath & "18d.png"
ElseIf Trim(lblcc1.Text) = "Dust" And lblDay1.Text = "Today" Then
picSmall1.ImageLocation = strPath & "19d.png"
ElseIf Trim(lblcc1.Text) = "Dust" And lblDay1.Text = "Tonight" Then
picSmall1.ImageLocation = strPath & "19n.png"
ElseIf Trim(lblcc1.Text) = "Foggy" Then
picSmall1.ImageLocation = strPath & "20d.png"
ElseIf Trim(lblcc1.Text) = "Haze" And lblDay1.Text = "Today" Then
picSmall1.ImageLocation = strPath & "21d.png"
ElseIf Trim(lblcc1.Text) = "Haze" And lblDay1.Text = "Tonight" Then
picSmall1.ImageLocation = strPath & "21n.png"
ElseIf Trim(lblcc1.Text) = "Smoky" And lblDay1.Text = "Today" Then
picSmall1.ImageLocation = strPath & "22d.png"
ElseIf Trim(lblcc1.Text) = "Smoky" And lblDay1.Text = "Tonight" Then
picSmall1.ImageLocation = strPath & "22n.png"
ElseIf Trim(lblcc1.Text) = "Blustery" Then
picSmall1.ImageLocation = strPath & "23d.png"
ElseIf Trim(lblcc1.Text) = "Windy" Then
picSmall1.ImageLocation = strPath & "24d.png"
ElseIf Trim(lblcc1.Text) = "Cold" Then
picSmall1.ImageLocation = strPath & "25d.png"
ElseIf Trim(lblcc1.Text) = "Cloudy" Then
picSmall1.ImageLocation = strPath & "26d.png"
ElseIf Trim(lblcc1.Text) = "Mostly Cloudy" Then
picSmall1.ImageLocation = strPath & "28d.png"
ElseIf Trim(lblcc1.Text) = "Partly Cloudy" Then
picSmall1.ImageLocation = strPath & "30d.png"
ElseIf Trim(lblcc1.Text) = "Clouds Late/Clearing Early" Then
picSmall1.ImageLocation = strPath & "26d.png"
ElseIf Trim(lblcc1.Text) = "Clouds Early/Clearing Late" Then
picSmall1.ImageLocation = strPath & "26d.png"
ElseIf Trim(lblcc1.Text) = "Clear" Then
picSmall1.ImageLocation = strPath & "31d.png"
ElseIf Trim(lblcc1.Text) = "Mostly Clear" Then
picSmall1.ImageLocation = strPath & "31d.png"
ElseIf Trim(lblcc1.Text) = "AM Clear" Then
picSmall1.ImageLocation = strPath & "31d.png"
ElseIf Trim(lblcc1.Text) = "PM Clear" Then
picSmall1.ImageLocation = strPath & "31n.png"
ElseIf Trim(lblcc1.Text) = "Mostly Sunny" Then
picSmall1.ImageLocation = strPath & "32d.png"
ElseIf Trim(lblcc1.Text) = "Sunny" Then
picSmall1.ImageLocation = strPath & "32d.png"
ElseIf Trim(lblcc1.Text) = "Fair" Then
picSmall1.ImageLocation = strPath & "33d.png"
ElseIf Trim(lblcc1.Text) = "Mixed Rain and Hail" Then
picSmall1.ImageLocation = strPath & "35d.png"
ElseIf Trim(lblcc1.Text) = "Hot" Then
picSmall1.ImageLocation = strPath & "36d.png"
ElseIf Trim(lblcc1.Text) = "Isolated Thunderstorms" Then
picSmall1.ImageLocation = strPath & "37d.png"
ElseIf Trim(lblcc1.Text) = "Scattered Thunderstorms" Then
picSmall1.ImageLocation = strPath & "38d.png"
ElseIf Trim(lblcc1.Text) = "PM Thunderstorms" Then
picSmall1.ImageLocation = strPath & "38n.png"
ElseIf Trim(lblcc1.Text) = "Thunderstorms Late" Then
picSmall1.ImageLocation = strPath & "38n.png"
ElseIf Trim(lblcc1.Text) = "AM Thunderstorms" Then
picSmall1.ImageLocation = strPath & "38d.png"
ElseIf Trim(lblcc1.Text) = "Thunderstorms Early" Then
picSmall1.ImageLocation = strPath & "38d.png"
ElseIf Trim(lblcc1.Text) = "PM Showers" Then
picSmall1.ImageLocation = strPath & "39n.png"
ElseIf Trim(lblcc1.Text) = "Showers Late" Then
picSmall1.ImageLocation = strPath & "39n.png"
ElseIf Trim(lblcc1.Text) = "Light Rain" Then
picSmall1.ImageLocation = strPath & "9d.png"
ElseIf Trim(lblcc1.Text) = "Rain" Then
picSmall1.ImageLocation = strPath & "9d.png"
ElseIf Trim(lblcc1.Text) = "Rain Early" Then
picSmall1.ImageLocation = strPath & "9d.png"
ElseIf Trim(lblcc1.Text) = "AM Showers" Then
picSmall1.ImageLocation = strPath & "39d.png"
ElseIf Trim(lblcc1.Text) = "Showers Early" Then
picSmall1.ImageLocation = strPath & "39d.png"
ElseIf Trim(lblcc1.Text) = "Few Showers" Then
picSmall1.ImageLocation = strPath & "39d.png"
ElseIf Trim(lblcc1.Text) = "Showers Late" Then
picSmall1.ImageLocation = strPath & "39n.png"
ElseIf Trim(lblcc1.Text) = "Scattered Showers" Then
picSmall1.ImageLocation = strPath & "40d.png"
ElseIf Trim(lblcc1.Text) = "Heavy Snow" Then
picSmall1.ImageLocation = strPath & "41d.png"
ElseIf Trim(lblcc1.Text) = "Scattered Snow Showers" Then
picSmall1.ImageLocation = strPath & "42d.png"
'Case "heavy snow"
' picSmall2.ImageLocation = strPath & "43d.png"
'Case "44"
' picSmall2.ImageLocation = strPath & "30d.png"
ElseIf Trim(lblcc1.Text) = "Thundershowers" Then
picSmall1.ImageLocation = strPath & "45d.png"
ElseIf Trim(lblcc1.Text) = "Snow Showers" Then
picSmall1.ImageLocation = strPath & "46d.png"
ElseIf Trim(lblcc1.Text) = "AM Thundershowers" Then
picSmall1.ImageLocation = strPath & "47d.png"
ElseIf Trim(lblcc1.Text) = "PM Thundershowers" Then
picSmall1.ImageLocation = strPath & "47n.png"
ElseIf Trim(lblcc1.Text) = "Isolated Thundershowers" Then
picSmall1.ImageLocation = strPath & "47d.png"
ElseIf Trim(lblcc1.Text) = "Rain/Thunder" Then
picSmall1.ImageLocation = strPath & "8d.png"
ElseIf Trim(lblcc1.Text) = "AM Clouds/PM Sun" Then
picSmall1.ImageLocation = strPath & "30d.png"
ElseIf Trim(lblcc1.Text) = "AM Sun/PM Clouds" Then
picSmall1.ImageLocation = strPath & "30d.png"
ElseIf Trim(lblcc1.Text) = "" Then
lblcc1.Text = "Not Available"
picSmall1.ImageLocation = strPath & "44d.png"
End If
End Sub
#End Region 'The 2-Day Forcast...
#Region "Five-Day Info..."
Private Sub GetFiveDates()
'Code by RSPercy 10/22/09
'Only have to retrieve the dates once.
lblDate1.Text = FormatDateTime(Now.Date, DateFormat.ShortDate).ToString()
lblDate2.Text = FormatDateTime(DateAdd(DateInterval.Day, 1, Now.Date))
lblDt1.Text = FormatDateTime(Now.Date, DateFormat.ShortDate).ToString()
lblDt2.Text = FormatDateTime(DateAdd(DateInterval.Day, 1, Now.Date))
lblDt3.Text = FormatDateTime(DateAdd(DateInterval.Day, 2, Now.Date))
lblDt4.Text = FormatDateTime(DateAdd(DateInterval.Day, 3, Now.Date))
lblDt5.Text = FormatDateTime(DateAdd(DateInterval.Day, 4, Now.Date))
End Sub
Private Sub GetFiveDayInfo()
'Code by RSPercy 10/22/09
Try
Dim parts() As String
Dim parts1() As String
Dim parts2() As String
Dim parts3() As String
Dim m As Match
Dim strMatch As String = String.Empty
Dim strMatch2 As String
Dim t As New YahooWeatherLib.YahooWeatherForecast(txtZip.Text, "f")
Dim patternAA As String = "\<\w*\>\<\w*\s\w*\=\w*\-\w*\:\w*\(\'\w*\:\/\/\w*\.\w*\.\w*\/\w*\/\w*\/\w*\/\w*\/\w*\/\w*\/\w*\.\w*\'\)\;\>(\w*|\w*\s\w*|\w*\s\w*\s\w*|\w*\s\w*\s\w*\s\w*|\w*\/\w*|\w*\s\w*\/\w*\s\w*|\w*\s\w*-\w*|\w*-\w*)\<"
Dim pattern5Day As String = "\<\w*\>\w*\<\/\w*\>\<\w*\>\w*\<\/\w*\>\<\w*\>\w*\<\/\w*\>\<\w*\>\w*\<\/\w*\>\<\w*\>\w*\<\/\w*\>"
Dim patternHiLow As String = "\<\w*\>\w*\:\s\d{1,3}\&\#\d{1,3}\;\s\<\w*\>\w*\:\s\d{1,3}"
Dim strImages As String = "\w*\:\/\/\w*\.\w*\.\w*\/\w*\/\w*\/\w*\/\w*\/\w*\/\w*\/\d{1,2}\w*\.\w*\'"
Dim strNearbyLocations As String = "US\w{2}\d{4}\/\w*\.\w*\>(\w*\<|\w*\s\w*\<|\w*\s\w*\s\w*\<)"
strGUID = t.rss.channel.item.guid
'USGA0273_2009_18_10_00_EDT. Your guid will be different.
parts = Split(strGUID, "_")
'Create a request using a URL that can receive a post.
Dim request As WebRequest = WebRequest.Create("http://weather.yahoo.com/forecast/" & parts(0) & "_f.html")
'Create POST data and convert it to a byte array.
request.Method = "POST"
Dim postData As String = "This is a test that posts this string to a Web server."
' Set the ContentType property of the WebRequest.
Dim byteArray As Byte() = Encoding.UTF8.GetBytes(postData)
' Set the ContentType property of the WebRequest.
request.ContentType = "application/x-www-form-urlencoded"
' Set the ContentLength property of the WebRequest.
request.ContentLength = byteArray.Length
'Create datastream and a response stream.
Dim dataStream As Stream = request.GetRequestStream()
' Write the data to the request stream, then close it
dataStream.Write(byteArray, 0, byteArray.Length)
dataStream.Close()
' Get the response.
Dim response As WebResponse = request.GetResponse()
' Get the status.
Dim myString As String = CType(response, HttpWebResponse).StatusDescription
' Get the stream containing content returned by the server.
dataStream = response.GetResponseStream()
' Open the stream using a StreamReader for easy access.
Dim sr As StreamReader = New StreamReader(dataStream)
' Put the content in a textbox.
Dim myTB As TextBox = New TextBox
myTB.Multiline = True
myTB.Text = sr.ReadToEnd
' Clean up the streams.
sr.Close()
dataStream.Close()
response.Close()
'Get the days of the week.
For Each m In Regex.Matches(myTB.Text, pattern5Day, RegexOptions.Multiline)
strMatch = m.Value
If strMatch = Nothing Then
Exit For
Else
strMatch = strMatch.Replace("<th>", "")
strMatch = strMatch.Replace("</th>", ",")
'MessageBox.Show(strMatch) 'For testing ONLY
parts = Split(strMatch, ",")
If parts(0) = "Today" Then
lblDay1.Text = parts(0)
lblDay2.Text = parts(1)
lblDay3.Text = parts(2)
lblDay4.Text = parts(3)
lblDay5.Text = parts(4)
ElseIf parts(0) = "Tonight" Then
lblDay1.Text = parts(0)
lblDay2.Text = parts(1)
lblDay3.Text = parts(2)
lblDay4.Text = parts(3)
lblDay5.Text = parts(4)
End If
End If
Next
strMatch = String.Empty
'Get the Highs and Lows.
For Each m In Regex.Matches(myTB.Text, patternHiLow, RegexOptions.Multiline)
strMatch += m.Value
Next
strMatch = strMatch.Replace("<td>High: ", ",")
strMatch = strMatch.Replace("° <div>Low: ", ",")
'MessageBox.Show(strMatch) 'For testing ONLY
parts1 = Split(strMatch, ",")
lblHi1.Text = "High : " & parts1(1)
lblLo1.Text = "Low : " & parts1(2)
lblHi2.Text = "High : " & parts1(3)
lblLo2.Text = "Low : " & parts1(4)
lblHi3.Text = "High : " & parts1(5)
lblLo3.Text = "Low : " & parts1(6)
lblHi4.Text = "High : " & parts1(7)
lblLo4.Text = "Low : " & parts1(8)
lblHi5.Text = "High : " & parts1(9)
lblLo5.Text = "Low : " & parts1(10)
strMatch = String.Empty
'Get the Images we need.
For Each m In Regex.Matches(myTB.Text, strImages, RegexOptions.Multiline)
strMatch += m.Value
Next
strMatch = strMatch.Replace("'", ",")
'MessageBox.Show(strMatch) 'For testing ONLY
'This produces 7 image paths.
'We will use the last 5, (2 thru 6)
parts2 = Split(strMatch, ",")
pbDay1.ImageLocation = parts2(2)
pbDay2.ImageLocation = parts2(3)
pbDay3.ImageLocation = parts2(4)
pbDay4.ImageLocation = parts2(5)
pbDay5.ImageLocation = parts2(6)
strMatch = String.Empty
strMatch2 = myTB.Text
strMatch2 = strMatch2.Replace("""", "")
'Get Nearby locations.
For Each m In Regex.Matches(strMatch2, strNearbyLocations, RegexOptions.Multiline)
strMatch += m.Value
Next
strMatch = strMatch.Replace("forecast.html>", "")
strMatch = strMatch.Replace("/", ",")
strMatch = strMatch.Replace("""", "")
strMatch = strMatch.Replace("<", ",")
'MessageBox.Show(strMatch) 'For testing ONLY
parts = Split(strMatch, ",")
'Clear the combo boxes.
cmbNearbyLocations.Items.Clear()
cmbNearbyLocations2.Items.Clear()
'Lets load the combo boxes.
cmbNearbyLocations.Items.Add(parts(1))
cmbNearbyLocations.Items.Add(parts(3))
cmbNearbyLocations.Items.Add(parts(5))
cmbNearbyLocations.Items.Add(parts(7))
cmbNearbyLocations.Items.Add(parts(9))
cmbNearbyLocations.Items.Add(parts(11))
cmbNearbyLocations2.Items.Add(parts(0))
cmbNearbyLocations2.Items.Add(parts(2))
cmbNearbyLocations2.Items.Add(parts(4))
cmbNearbyLocations2.Items.Add(parts(6))
cmbNearbyLocations2.Items.Add(parts(8))
cmbNearbyLocations2.Items.Add(parts(10))
strMatch = String.Empty
strMatch2 = strMatch2.Replace("9", "")
strMatch2 = strMatch2.Replace("8", "")
strMatch2 = strMatch2.Replace("7", "")
strMatch2 = strMatch2.Replace("6", "")
strMatch2 = strMatch2.Replace("5", "")
strMatch2 = strMatch2.Replace("4", "")
strMatch2 = strMatch2.Replace("3", "")
strMatch2 = strMatch2.Replace("2", "")
strMatch2 = strMatch2.Replace("1", "")
strMatch2 = strMatch2.Replace("0", "")
myTB.Text = ""
myTB.Text = strMatch2
'Get the five conditions that we need.
For Each m In Regex.Matches(myTB.Text, patternAA)
strMatch += m.Value
Next
strMatch = strMatch.Replace("<td><div style=background-image:url('http://l.yimg.com/a/i/us/nws/weather/gr/s.png');>", "")
strMatch = strMatch.Replace("<", ",")
parts3 = Split(strMatch, ",")
lblCon1.Text = parts3(0)
lblCon2.Text = parts3(1)
lblCon3.Text = parts3(2)
lblCon4.Text = parts3(3)
lblCon5.Text = parts3(4)
strMatch = String.Empty
Catch ex As Exception
MessageBox.Show("Unexplained Error has occured," & vbCrLf _
& "The 5-Day Weather Forecast" & vbCrLf _
& "will be unavailable. Please" & vbCrLf _
& "try again later.", "Info to the Rescue", MessageBoxButtons.OK, MessageBoxIcon.Information)
End Try
End Sub
#End Region 'Five-Day Info...
#Region "Surrounding Areas..."
Private Sub cmbNearbyLocations_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbNearbyLocations.SelectedIndexChanged
'Code by RSPercy 10/22/09
Select Case cmbNearbyLocations.SelectedIndex
Case 0
cmbNearbyLocations2.SelectedIndex = 0
Case 1
cmbNearbyLocations2.SelectedIndex = 1
Case 2
cmbNearbyLocations2.SelectedIndex = 2
Case 3
cmbNearbyLocations2.SelectedIndex = 3
Case 4
cmbNearbyLocations2.SelectedIndex = 4
Case 5
cmbNearbyLocations2.SelectedIndex = 5
End Select
End Sub
Private Sub GetFiveDayNearbyLocation()
'Code by RSPercy 10/22/09
Try
Dim parts1() As String
Dim parts2() As String
Dim parts3() As String
Dim m As Match
Dim strMatch As String = String.Empty
Dim strMatch2 As String
Dim patternAA As String = "\<\w*\>\<\w*\s\w*\=\w*\-\w*\:\w*\(\'\w*\:\/\/\w*\.\w*\.\w*\/\w*\/\w*\/\w*\/\w*\/\w*\/\w*\/\w*\.\w*\'\)\;\>(\w*|\w*\s\w*|\w*\s\w*\s\w*|\w*\s\w*\s\w*\s\w*|\w*\/\w*|\w*\s\w*\/\w*\s\w*|\w*\s\w*-\w*|\w*-\w*)\<"
Dim patternHiLow As String = "\<\w*\>\w*\:\s\d{1,3}\&\#\d{1,3}\;\s\<\w*\>\w*\:\s\d{1,3}"
Dim strImages As String = "\w*\:\/\/\w*\.\w*\.\w*\/\w*\/\w*\/\w*\/\w*\/\w*\/\w*\/\d{1,2}\w*\.\w*\'"
'Create a request using a URL that can receive a post.
Dim request As WebRequest = WebRequest.Create("http://weather.yahoo.com/forecast/" & cmbNearbyLocations2.SelectedItem.ToString() & "_f.html")
'Create POST data and convert it to a byte array.
request.Method = "POST"
Dim postData As String = "This is a test that posts this string to a Web server."
' Set the ContentType property of the WebRequest.
Dim byteArray As Byte() = Encoding.UTF8.GetBytes(postData)
' Set the ContentType property of the WebRequest.
request.ContentType = "application/x-www-form-urlencoded"
' Set the ContentLength property of the WebRequest.
request.ContentLength = byteArray.Length
'Create datastream and a response stream.
Dim dataStream As Stream = request.GetRequestStream()
' Write the data to the request stream, then close it
dataStream.Write(byteArray, 0, byteArray.Length)
dataStream.Close()
' Get the response.
Dim response As WebResponse = request.GetResponse()
' Get the status.
Dim myString As String = CType(response, HttpWebResponse).StatusDescription
' Get the stream containing content returned by the server.
dataStream = response.GetResponseStream()
' Open the stream using a StreamReader for easy access.
Dim sr As StreamReader = New StreamReader(dataStream)
' Put the content in a textbox.
Dim myTB As TextBox = New TextBox
myTB.Multiline = True
myTB.Text = sr.ReadToEnd
' Clean up the streams.
sr.Close()
dataStream.Close()
response.Close()
'Get the Highs and Lows.
For Each m In Regex.Matches(myTB.Text, patternHiLow, RegexOptions.Multiline)
strMatch += m.Value
Next
strMatch = strMatch.Replace("<td>High: ", ",")
strMatch = strMatch.Replace("° <div>Low: ", ",")
'MessageBox.Show(strMatch) 'For testing ONLY
parts1 = Split(strMatch, ",")
lblHi1.Text = "High : " & parts1(1)
lblLo1.Text = "Low : " & parts1(2)
lblHi2.Text = "High : " & parts1(3)
lblLo2.Text = "Low : " & parts1(4)
lblHi3.Text = "High : " & parts1(5)
lblLo3.Text = "Low : " & parts1(6)
lblHi4.Text = "High : " & parts1(7)
lblLo4.Text = "Low : " & parts1(8)
lblHi5.Text = "High : " & parts1(9)
lblLo5.Text = "Low : " & parts1(10)
strMatch = String.Empty
'Get the Images we need.
For Each m In Regex.Matches(myTB.Text, strImages, RegexOptions.Multiline)
strMatch += m.Value
Next
strMatch = strMatch.Replace("'", ",")
'This produces 7 image paths.
'We will use the last 5, (2 thru 6)
parts2 = Split(strMatch, ",")
pbDay1.ImageLocation = parts2(2)
pbDay2.ImageLocation = parts2(3)
pbDay3.ImageLocation = parts2(4)
pbDay4.ImageLocation = parts2(5)
pbDay5.ImageLocation = parts2(6)
strMatch = String.Empty
strMatch2 = myTB.Text
strMatch2 = strMatch2.Replace("""", "")
strMatch2 = strMatch2.Replace("9", "")
strMatch2 = strMatch2.Replace("8", "")
strMatch2 = strMatch2.Replace("7", "")
strMatch2 = strMatch2.Replace("6", "")
strMatch2 = strMatch2.Replace("5", "")
strMatch2 = strMatch2.Replace("4", "")
strMatch2 = strMatch2.Replace("3", "")
strMatch2 = strMatch2.Replace("2", "")
strMatch2 = strMatch2.Replace("1", "")
strMatch2 = strMatch2.Replace("0", "")
myTB.Text = ""
myTB.Text = strMatch2
'Get the five conditions that we need.
For Each m In Regex.Matches(myTB.Text, patternAA)
strMatch += m.Value
Next
strMatch = strMatch.Replace("<td><div style=background-image:url('http://l.yimg.com/a/i/us/nws/weather/gr/s.png');>", "")
strMatch = strMatch.Replace("<", ",")
parts3 = Split(strMatch, ",")
lblCon1.Text = parts3(0)
lblCon2.Text = parts3(1)
lblCon3.Text = parts3(2)
lblCon4.Text = parts3(3)
lblCon5.Text = parts3(4)
strMatch = String.Empty
Catch ex As Exception
MessageBox.Show("Unexplained Error has occured," & vbCrLf _
& "The 5-Day Weather Forecast" & vbCrLf _
& "will be unavailable. Please" & vbCrLf _
& "try again later.", "Info to the Rescue", MessageBoxButtons.OK, MessageBoxIcon.Information)
End Try
End Sub
Private Sub cmbNearbyLocations2_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbNearbyLocations2.SelectedIndexChanged
'Code by RSPercy 10/22/09
GetFiveDayNearbyLocation()
End Sub
#End Region 'Surrounding Areas...
End Class
Submit an article or tip