微天气

• 下载 TinyWeatherProject - 305.6 KB
• 下载 WindPointerProject - 87.3 KB

引言

Tiny Weather 使用 Weather Underground 和 Freegeoip.net 的服务，此应用程序仅获取当前天气状况，但使用 Weather Underground，您可以获得更多信息。

我们以 JSON 格式获取天气数据，因此我们需要使用 NewtonSoft.json.dll 来解析数据（链接如下）。获取您的位置可以像手动输入一样简单，或者我们可以使用 freegeoip.net 服务通过您的 IP 地址进行地理定位，此数据也以 JSON 格式提供。

此外，将在此项目中添加一个额外的类，一个风向标。此类是一个 Windows Forms 控件，用于显示风向，因为风向数据给出一个罗盘方向。它通常意味着风从该方向吹来，而不是吹向该方向。因此，为了解决这个问题，我们在自定义控件中反转图像。

为了获得任何天气数据，您需要从 weather underground 获取一个 API 密钥，它是免费的，但有使用限制。您在 24 小时内调用天气数据的次数可能不超过 500 次，并且使用 Stratus 计划（开发人员许可证的第一个免费计划）可以获取的天气数据量有限。

• http://www.newtonsoft.com/json - Newtonsoft.json.dll
• https://www.wunderground.com/weather/api - Weather Underground

下载 Newtonsoft.json.dll 并将文件放在您的应用程序文件夹中。

屏幕截图

Using the Code

首先，让我们添加对 NewtonSoft.json.dll 的引用，在解决方案资源管理器中，右键单击应用程序名称并选择“添加引用”。

浏览到您的应用程序文件夹并选择 Newtonsoft.json.dll。

Form 1 具有工具箱中的以下项目

1. 6 个标签
2. 一个 picturebox
3. 2 个按钮
4. 风向标（以下添加的类）

让我们首先编写 Form 1 的代码

现在让我们导入一些东西

Imports System
Imports System.IO
Imports System.Net
Imports Newtonsoft.Json
Imports Newtonsoft.Json.Linq

Public Class Form1

    Dim deg As String = Chr(176)    'degree symbol
    Dim iconKey As String = ""
    Dim minuteCounter As Integer = 30 ' for updating the weather every 30 minutes
    Dim i As Integer = 60             ' 
    Dim str As String = ""
    Dim tmp_locationstr As String   'temp string to load the location settings to
    Dim _ApiKey As String           'the key you got from weather underground
    'settings are covered later

    ' weather conditions we want to parse from the weather data, 
    ' there's a lot but many are not used
    ' you may wish to pick and choose what you want
#Region "Conditions"

    Public LocationFullName, City, State, StateName, Country, CountryISO, _
    Zip, Magic, WMO, Latitude, Longitude, ElevationMeters, ElevationFeet As String
    Public StationID, ObservationTime, ObservationTime_RFC822, ObservationEpoch As String
    Public LocalTime_RFC822, LocalEpoch, LocalTimeZone_Short, _
    LocalTimeZone_Long, LocalTimeZone_Offset As String
    Public WeatherDescription, TempreatureString, Temp_F, Temp_C, RelativeHumidity As String
    Public WindString, WindDir, WindDegrees, _
    WindMPH, WindGustMPH, WindKPH, WindGustKPH As String
    Public PressureMB, PressureIN, PressureTrend As String
    Public DewpointString, Dewpoint_F, Dewpoint_C As String
    Public HeatIndexString, HeatIndex_F, HeatIndex_C As String
    Public WindChillString, WindChill_F, WindChill_C As String
    Public FeelsLikeString, FeelsLike_F, FeelsLike_C As String
    Public Visibiltiy_M, Visibility_K As String
    Public SolarRadiation, UVIndex As String
    Public PrecipitationString_1HR, Precipitation_1HR_In, _
    Precipitation_1HR_Metric, PrecipitationString_Today, _
    Precipitation_Today_In, Precipitation_Today_Metric As String
    Public IconName, IconURL As String ' weather underground has a few icon sets to choose from

#End Region

    Private Sub Form1_Load(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles MyBase.Load
        
        Timer1.Start()
        lclTempUnit.Text = deg & "c"
        _ApiKey = My.Settings.apikey                   ' load your api key from settings
        tmp_locationstr = My.Settings.locationstring   ' load your location from settings

        GetWeather(_ApiKey)    'call public sub GetWeather()
        UpdateLabels()         ' call the sub to update the necessary labels with weather data

    End Sub

    Public Sub GetWeather(ByVal key As String)    ' GetWeather("api key goes here")

        'create a api web request
        Dim req As HttpWebRequest = DirectCast(WebRequest.Create_
        ("http://api.wunderground.com/api/" & key & _
        "/conditions/q/" & tmp_locationstr & ".json"), HttpWebRequest)
        'create a variable to handle the response from the web request
        Dim res As HttpWebResponse = DirectCast(req.GetResponse(), HttpWebResponse)
       
        Dim reader As New StreamReader(res.GetResponseStream())    'to read the response
        Dim serverResponse As String = reader.ReadToEnd            '
        Dim json As String = serverResponse                        '
        Dim obj As JObject = JObject.Parse(json)                   'create json object

        Try
            ' also here you may wish to keep only what you want
            LocationFullName = obj.SelectToken("current_observation").SelectToken_
            ("display_location").SelectToken("full")
            City = obj.SelectToken("current_observation").SelectToken_
            ("display_location").SelectToken("city")
            State = obj.SelectToken("current_observation").SelectToken_
            ("display_location").SelectToken("state")
   
            WeatherDescription = obj.SelectToken("current_observation").SelectToken("weather")
            TempreatureString = obj.SelectToken("current_observation").SelectToken("temperature_string")
            Temp_F = obj.SelectToken("current_observation").SelectToken("temp_f")
            Temp_C = obj.SelectToken("current_observation").SelectToken("temp_c")
            RelativeHumidity = obj.SelectToken("current_observation").SelectToken("relative_humidity")

            WindString = obj.SelectToken("current_observation").SelectToken("wind_string")
            WindDir = obj.SelectToken("current_observation").SelectToken("wind_dir")
            'wind degrees is what is used for the wind pointer
            WindDegrees = obj.SelectToken("current_observation").SelectToken("wind_degrees")
            WindMPH = obj.SelectToken("current_observation").SelectToken("wind_mph")
            WindGustMPH = obj.SelectToken("current_observation").SelectToken("wind_gust_mph")
            WindKPH = obj.SelectToken("current_observation").SelectToken("wind_kph")
            WindGustKPH = obj.SelectToken("current_observation").SelectToken("wind_gust_kph")

            PressureMB = obj.SelectToken("current_observation").SelectToken("pressure_mb")
            PressureIN = obj.SelectToken("current_observation").SelectToken("pressure_in")
            PressureTrend = obj.SelectToken("current_observation").SelectToken("pressure_trend")

            DewpointString = obj.SelectToken("current_observation").SelectToken("dewpoint_string")
            Dewpoint_F = obj.SelectToken("current_observation").SelectToken("dewpoint_f")
            Dewpoint_C = obj.SelectToken("current_observation").SelectToken("dewpoint_c")

            HeatIndexString = obj.SelectToken("current_observation").SelectToken("heat_index_string")
            HeatIndex_F = obj.SelectToken("current_observation").SelectToken("heat_index_f")
            HeatIndex_C = obj.SelectToken("current_observation").SelectToken("heat_index_c")

            WindChillString = obj.SelectToken("current_observation").SelectToken("windchill_string")
            WindChill_F = obj.SelectToken("current_observation").SelectToken("windchill_f")
            WindChill_C = obj.SelectToken("current_observation").SelectToken("windchill_c")

            FeelsLikeString = obj.SelectToken("current_observation").SelectToken("feelslike_string")
            FeelsLike_F = obj.SelectToken("current_observation").SelectToken("feelslike_f")
            FeelsLike_C = obj.SelectToken("current_observation").SelectToken("feelslike_c")

            Visibiltiy_M = obj.SelectToken("current_observation").SelectToken("visibility_mi")
            Visibility_K = obj.SelectToken("current_observation").SelectToken("visibility_km")

            SolarRadiation = obj.SelectToken("current_observation").SelectToken("solarradiation")
            UVIndex = obj.SelectToken("current_observation").SelectToken("UV")

            PrecipitationString_1HR = _
               obj.SelectToken("current_observation").SelectToken("precip_1hr_string")
            Precipitation_1HR_In = obj.SelectToken("current_observation").SelectToken("precip_1hr_in")
            Precipitation_1HR_Metric = _
               obj.SelectToken("current_observation").SelectToken("precip_1hr_metric")

            PrecipitationString_Today = _
               obj.SelectToken("current_observation").SelectToken("precip_today_string")
            Precipitation_Today_In = _
               obj.SelectToken("current_observation").SelectToken("precip_today_in")
            Precipitation_Today_Metric = _
               obj.SelectToken("current_observation").SelectToken("precip_today_metric")

            IconName = obj.SelectToken("current_observation").SelectToken("icon")
            IconURL = obj.SelectToken("current_observation").SelectToken("icon_url")
            ''''''''''''''''''''''''''''''''''''''''''''
           
        Catch ex As Exception
             ' normally i'd add "msgbox(ex.message)" here but i didn't have any errors
        End Try

    End Sub

    Public Sub UpdateLabels()

        lblTempMain.Text = Temp_C.ToString                       'most relative information
        WindSock_A1.Angle = WindDegrees                          'set the value for the custom control
        lblWindSpeed.Text = "Spd: " & WindMPH & ".mph"           '
        lblWindDir.Text = "Dir: " & WindDir.ToString             '
        lblHumidity.Text = "Hm: " & RelativeHumidity.ToString    '
        lblPressure.Text = "Pr: " & PressureIN.ToString & ".in"  '

        'weather underground has icon sets ranging from a to k find an icon set you like
        'and replace the "g" in the line below to the one you choose
        Dim icnURL As String = "http://icons.wxug.com/i/c/" & "g" & "/" & IconName & ".gif"
        Dim cli As New WebClient    'create a new webclient to download the current weather icon
        Dim tmpBitmap As Bitmap     'create a bitmap to store the icon image
        tmpBitmap = Bitmap.FromStream(New MemoryStream(cli.DownloadData(icnURL)))    'download the image
        pbIcon.Image = tmpBitmap    'display the icon

    End Sub

    ' show the settings window
    Private Sub Button2_Click(ByVal sender As System.Object, _
                   ByVal e As System.EventArgs) Handles Button2.Click
        Form2.Show()
    End Sub

    ' a reminder that the data updates automatically so not to go over the limit while debugging
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
            Handles Button1.Click
        MsgBox("The Weather will update every 30 minutes." & vbCr & _
             "Time till next update is: " & minuteCounter & " minutes , " & i & "seconds.", _
             MsgBoxStyle.Information, "Help:")
    End Sub

    'update timer
    Private Sub Timer1_Tick(ByVal sender As System.Object, _
                   ByVal e As System.EventArgs) Handles Timer1.Tick
       
        i -= 1
        Me.Text = "Tiny Weather: " & " " & WeatherDescription & " - " _
                      & City & "    " & i & "  " & minuteCounter
        If i = 0 AndAlso minuteCounter <= 30 Then
            i = 60
            minuteCounter -= 1
            If minuteCounter <= 0 Then
                minuteCounter = 30
                GetWeather(_ApiKey)
                UpdateLabels()
            End If
        End If

    End Sub

End Class

Form 1 完成 - 让我们继续到 form2

与 Form 1 一样，我们需要导入 newtonsoft.json 以解析来自地理定位服务的位置数据

freegeoip.net。

此窗体具有工具箱中的以下项目

1. 2 个文本框
2. 3 个按钮
3. groupbox（可选）

是时候添加一些设置了，转到项目选项卡并选择左侧面板上的“您的应用程序名称”属性，选择“设置”并添加 2 个新设置，将 apikey 设置为字符串类型，将 locationstring 设置为字符串类型，保持范围不变。

Imports System.Net
Imports System.IO
Imports Newtonsoft.Json.Linq

Public Class Form2

    Dim _city, _country, _key As String


    Private Sub Form2_Load(ByVal sender As System.Object, _
                 ByVal e As System.EventArgs) Handles MyBase.Load

        lbl_apikey.ForeColor = Color.Black             'change the label forecolor back to normal
        txt_apikey.Text = My.Settings.apikey           'load your key from settings
        txt_location.Text = My.Settings.locationstring ' load your location from settings

    End Sub

    'geo location
    'as before we use a web request and 
    'web response to get the data based on your ip address 
    Private Sub btn_geolocate_Click(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles btn_geolocate.Click

        ' if used as is the line below will get your location 
        ' from your ip address but you can use another ip
        'address or hostname "http://freegeoip.net/json/google.com" for example
        Dim _request As HttpWebRequest = DirectCast_
        (WebRequest.Create("http://freegeoip.net/json/"), HttpWebRequest)
        Dim _response As HttpWebResponse = DirectCast(_request.GetResponse, HttpWebResponse)
        Dim _reader As New StreamReader(_response.GetResponseStream())
        Dim _ServerResponse As String = _reader.ReadToEnd
        Dim _json As String = _ServerResponse
        Dim _Jobject As JObject = JObject.Parse(_json)

        Try    
            _city = _Jobject.SelectToken("city")
            _country = _Jobject.SelectToken("country_code")
            txt_location.Text = _country & "/" & _city

        Catch ex As Exception
            'MsgBox(ex.Message)
        End Try

    End Sub

    Private Sub btn_save_Click(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles btn_save.Click
       ' a warning to make sure the api key is present
        If txt_apikey.Text = Nothing Then
            lbl_apikey.ForeColor = Color.Red
            MsgBox("You need an api key to get the weather.")
        Else

            lbl_apikey.ForeColor = Color.Black
        End If
 
        'set and save settings
        My.Settings.apikey = txt_apikey.Text
        My.Settings.locationstring = txt_location.Text    'you can still type your location manually
        My.Settings.Save()                                'and save settings

    End Sub

    'close the form
    Private Sub btn_close_Click(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles btn_close.Click
        Me.Close()
    End Sub

End Class

form2 就完成了。

风向标控件类

最好为此控件创建一个新的类项目。

我使用 .NET Framework 2.0 制作我的控件。

您需要通过转到项目选项卡中的“项目名称”属性并选择资源，然后简单地将箭头图像拖放到此处，来将提供的箭头图像添加到项目的资源中。

接收到风向时，风在气象学上是从该方向吹来的。

Imports System.Windows.Forms
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging
Imports System.IO

Public Class WindSock_A : Inherits Control    ' name the control whatever you like

    Dim myimg As Bitmap                      'new bitmap
    Dim _angle As Single                     'angle (as float)
    Dim _p As Pen                            'new pen
    Dim _arcColor As Color = Color.DimGray   'main color for the circle
    Dim _pWidth As Single = 1.0F             'pen width
    Dim _spacing As Single = 20.0F           'label spacing
    Dim _labelPoints As Boolean = True       'draw labels?

    Sub New()
        MyBase.New()
        Me.Width = 100     'initial width and height
        Me.Height = 100    '
       
        SetStyle(ControlStyles.SupportsTransparentBackColor, True)    'supports transparency
    End Sub

    ' properties to change
    Public Property ArcColor() As Color
        Get
            Return _arcColor
        End Get
        Set(ByVal value As Color)
            _arcColor = value
            Me.Invalidate()    'force redraw
        End Set
    End Property

    Public Property Angle() As Single
        Get
            Return _angle
        End Get
        Set(ByVal value As Single)
            _angle = value
            Me.Invalidate()    'force redraw
        End Set
    End Property

    Public Property ArcWidth() As Single
        Get
            Return _pWidth
        End Get
        Set(ByVal value As Single)
            _pWidth = value
            Me.Invalidate()    'force redraw
        End Set
    End Property

    Public Property DrawLabelPoints() As Boolean
        Get
            Return _labelPoints
        End Get
        Set(ByVal value As Boolean)
            _labelPoints = value
            Me.Invalidate()    'force redraw

        End Set
    End Property

    'drawing the control
    Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
        MyBase.OnPaint(e)

        'Quality
        e.Graphics.CompositingQuality = CompositingQuality.HighQuality
        e.Graphics.SmoothingMode = SmoothingMode.AntiAlias

        'image from resources
        myimg = My.Resources.arrow_100    'included insource files

        ' new pen
        _p = New Pen(New SolidBrush(_arcColor), _pWidth)

        '==\/ Label Text
        Dim nSize = e.Graphics.MeasureString("N", MyBase.Font)
        Dim eSize = e.Graphics.MeasureString("E", MyBase.Font)
        Dim sSize = e.Graphics.MeasureString("S", MyBase.Font)
        Dim wSize = e.Graphics.MeasureString("W", MyBase.Font)
        Dim nPoint As Point = New Point(Me.Width / 2 - _
        (CType(nSize.Width, Single) / 2), _spacing - (CType(nSize.Height, Single)))
        Dim ePoint As Point = New Point(Me.Width - _spacing, _
        Me.Height / 2 - (CType(eSize.Height, Single) / 2))
        Dim sPoint As Point = New Point(Me.Width / 2 - _
        (CType(sSize.Width, Single) / 2), Me.Height - _spacing)
        Dim wPoint As Point = New Point(1 + _spacing - _
        (CType(wSize.Width, Single)), Me.Height / 2 - (CType(wSize.Height, Single) / 2))
        '==/\ Label Text

        ' Draw the Circle
        e.Graphics.DrawArc(_p, _pWidth / 2, _pWidth / 2, _
        Me.Width - _pWidth - 1, Me.Height - _pWidth - 1, -90, 360)

        '===== Draw Arrow =====
        myimg.RotateFlip(RotateFlipType.RotateNoneFlipX)           ' flip the arrow to point 
                                                                   ' in the opposite direction
        e.Graphics.TranslateTransform(Me.Width / 2, Me.Height / 2) ' drawposition
        e.Graphics.RotateTransform(-90 + _angle)                   ' angle to rotate
        e.Graphics.DrawImage(myimg, -25, -25, 50, 50)              ' draw image at -half wxh with size
        e.Graphics.ResetTransform()                                ' reset once rotated
        '=========================>

        'Draw Labels
        If _labelPoints = True Then
            e.Graphics.DrawString_
            ("N", MyBase.Font, New SolidBrush(MyBase.ForeColor), nPoint)
            e.Graphics.DrawString_
            ("E", MyBase.Font, New SolidBrush(MyBase.ForeColor), ePoint)
            e.Graphics.DrawString_
            ("S", MyBase.Font, New SolidBrush(MyBase.ForeColor), sPoint)
            e.Graphics.DrawString_
            ("W", MyBase.Font, New SolidBrush(MyBase.ForeColor), wPoint)
        End If

        'graphics disposal after drawing
        e.Graphics.Dispose()
        _p.Dispose()
    End Sub

End Class

完成控件后，构建控件，转到构建文件夹，然后单击并将 .ddl 文件拖到天气应用程序工具箱中。

您现在可以将控件添加到您的天气应用程序中。

注释

风向控件名为 WindSock_A，因为我当时尝试了不同的东西。

如果运行下载的项目时遇到任何错误，请在提示时继续，然后转到设置

按钮。错误是因为应用程序在输入 API 密钥和位置之前启动，

输入后，天气将在 30 分钟后更新，当您再次启动应用程序时，您不会遇到相同的错误，但您可以调整代码以防止这种情况。

历史

• 2017 年 3 月 2 日：初始版本