vb谷歌地图特定位置

时间:2015-06-11 12:41:00

标签: vb.net google-maps



Imports System.Windows.Threading
Imports System.Threading
Imports System.Net
Imports System.Drawing
Imports System.IO
Imports Microsoft.Win32

Class Window1

#Region "Fields"
    Private geoDoc As XDocument
    Private location As String
    Private zoom As Integer
    Private saveDialog As New SaveFileDialog
    Private mapType As String
    Private lat As Double
    Private lng As Double
#End Region

    Private Sub GetGeocodeData()
        Dim geocodeURL As String = "http://maps.googleapis.com/maps/api/" & _
                                "geocode/xml?address=" & location & "&sensor=false"
        Try
            geoDoc = XDocument.Load(geocodeURL)
        Catch ex As WebException
            Me.Dispatcher.BeginInvoke(New ThreadStart(AddressOf HideProgressBar), _
                                      DispatcherPriority.Normal, Nothing)
            MessageBox.Show("Ensure that internet connection is available.", _
                            "Map App", MessageBoxButton.OK, MessageBoxImage.Error)
            Exit Sub
        End Try

        Me.Dispatcher.BeginInvoke(New ThreadStart(AddressOf ShowGeocodeData), _
                                  DispatcherPriority.Normal, Nothing)
    End Sub

    Private Sub ShowGeocodeData()
        Dim responseStatus = geoDoc...<status>.Single.Value()
        If (responseStatus = "OK") Then
            Dim formattedAddress = geoDoc...<formatted_address>(0).Value()
            Dim latitude = geoDoc...<location>(0).Element("lat").Value()
            Dim longitude = geoDoc...<location>(0).Element("lng").Value()
            Dim locationType = geoDoc...<location_type>(0).Value()

            AddressTxtBlck.Text = formattedAddress
            LatitudeTxtBlck.Text = latitude
            LongitudeTxtBlck.Text = longitude

            Select Case locationType
                Case "APPROXIMATE"
                    AccuracyTxtBlck.Text = "Approximate"
                Case "ROOFTOP"
                    AccuracyTxtBlck.Text = "Precise"
                Case Else
                    AccuracyTxtBlck.Text = "Approximate"
            End Select

            lat = Double.Parse(latitude)
            lng = Double.Parse(longitude)

            If (SaveButton.IsEnabled = False) Then
                SaveButton.IsEnabled = True
                RoadmapToggleButton.IsEnabled = True
                TerrainToggleButton.IsEnabled = True
            End If

        ElseIf (responseStatus = "ZERO_RESULTS") Then
            MessageBox.Show("Unable to show results for: " & vbCrLf & _
                            location, "Unknown Location", MessageBoxButton.OK, _
                            MessageBoxImage.Information)
            DisplayXXXXXXs()
            AddressTxtBox.SelectAll()
        End If
        ShowMapButton.IsEnabled = True
        ZoomInButton.IsEnabled = True
        ZoomOutButton.IsEnabled = True
        MapProgressBar.Visibility = Windows.Visibility.Hidden
    End Sub

    ' Get and display map image in Image ctrl.
    Private Sub ShowMapImage()
        Dim bmpImage As New BitmapImage()
        Dim mapURL As String = "http://maps.googleapis.com/maps/api/staticmap?" & _
                    "size=500x400&markers=size:mid%7Ccolor:red%7C" & _
                    location & "&zoom=" & zoom & "&maptype=" & mapType & "&sensor=false"

        bmpImage.BeginInit()
        bmpImage.UriSource = New Uri(mapURL)
        bmpImage.EndInit()

        MapImage.Source = bmpImage
    End Sub

    Private Sub ShowMapUsingLatLng()
        Dim bmpImage As New BitmapImage()
        Dim mapURL As String = "http://maps.googleapis.com/maps/api/staticmap?" & _
                    "center=" & lat & "," & lng & "&" & _
                    "size=500x400&markers=size:mid%7Ccolor:red%7C" & _
                    location & "&zoom=" & zoom & "&maptype=" & mapType & "&sensor=false"
        bmpImage.BeginInit()
        bmpImage.UriSource = New Uri(mapURL)
        bmpImage.EndInit()

        MapImage.Source = bmpImage
    End Sub

    ' Zoom-in on map.
    Private Sub ZoomIn()
        If (zoom < 21) Then
            zoom += 1
            ShowMapUsingLatLng()

            If (ZoomOutButton.IsEnabled = False) Then
                ZoomOutButton.IsEnabled = True
            End If
        Else
            ZoomInButton.IsEnabled = False
        End If
    End Sub

    ' Zoom-out on map.
    Private Sub ZoomOut()
        If (zoom > 0) Then
            zoom -= 1
            ShowMapUsingLatLng()

            If (ZoomInButton.IsEnabled = False) Then
                ZoomInButton.IsEnabled = True
            End If
        Else
            ZoomOutButton.IsEnabled = False
        End If
    End Sub

    Private Sub SaveMap()
        Dim mapURL As String = "http://maps.googleapis.com/maps/api/staticmap?" & _
                    "center=" & lat & "," & lng & "&" & _
                    "size=500x400&markers=size:mid%7Ccolor:red%7C" & _
                    location & "&zoom=" & zoom & "&maptype=" & mapType & "&sensor=false"
        Dim webClient As New WebClient()
        Try
            Dim imageBytes() As Byte = webClient.DownloadData(mapURL)
            Using ms As New MemoryStream(imageBytes)
                Image.FromStream(ms).Save(saveDialog.FileName, Imaging.ImageFormat.Png)
            End Using
        Catch ex As WebException
            MessageBox.Show("Unable to save map. Ensure that you are" & _
                            " connected to the internet.", "Error!", _
                            MessageBoxButton.OK, MessageBoxImage.Stop)
            Exit Sub
        End Try
    End Sub

    Private Sub MoveUp()
        ' Default zoom is 15 and at this level changing
        ' the center point is done by 0.003 degrees. 
        ' Shifting the center point is done by higher values
        ' at zoom levels less than 15.
        Dim diff As Double
        Dim shift As Double
        ' Use 88 to avoid values beyond 90 degrees of lat.
        If (lat < 88) Then
            If (zoom = 15) Then
                lat += 0.003
            ElseIf (zoom > 15) Then
                diff = zoom - 15
                shift = ((15 - diff) * 0.003) / 15
                lat += shift
            Else
                diff = 15 - zoom
                shift = ((15 + diff) * 0.003) / 15
                lat += shift
            End If
            ShowMapUsingLatLng()
        Else
            lat = 90
        End If
    End Sub

    Private Sub MoveDown()
        Dim diff As Double
        Dim shift As Double
        If (lat > -88) Then
            If (zoom = 15) Then
                lat -= 0.003
            ElseIf (zoom > 15) Then
                diff = zoom - 15
                shift = ((15 - diff) * 0.003) / 15
                lat -= shift
            Else
                diff = 15 - zoom
                shift = ((15 + diff) * 0.003) / 15
                lat -= shift
            End If
            ShowMapUsingLatLng()
        Else
            lat = -90
        End If
    End Sub

    Private Sub MoveLeft()
        Dim diff As Double
        Dim shift As Double
        ' Use -178 to avoid negative values below -180.
        If (lng > -178) Then
            If (zoom = 15) Then
                lng -= 0.003
            ElseIf (zoom > 15) Then
                diff = zoom - 15
                shift = ((15 - diff) * 0.003) / 15
                lng -= shift
            Else
                diff = 15 - zoom
                shift = ((15 + diff) * 0.003) / 15
                lng -= shift
            End If
            ShowMapUsingLatLng()
        Else
            lng = 180
        End If
    End Sub

    Private Sub MoveRight()
        Dim diff As Double
        Dim shift As Double
        If (lng < 178) Then
            If (zoom = 15) Then
                lng += 0.003
            ElseIf (zoom > 15) Then
                diff = zoom - 15
                shift = ((15 - diff) * 0.003) / 15
                lng += shift
            Else
                diff = 15 - zoom
                shift = ((15 + diff) * 0.003) / 15
                lng += shift
            End If
            ShowMapUsingLatLng()
        Else
            lng = -180
        End If
    End Sub

    Private Sub DisplayXXXXXXs()
        AddressTxtBlck.Text = "XXXXXXXXX, XXXXX, XXXXXX"
        LatitudeTxtBlck.Text = "XXXXXXXXXX"
        LongitudeTxtBlck.Text = "XXXXXXXXXX"
        AccuracyTxtBlck.Text = "XXXXXXXXX"
    End Sub

    Private Sub HideProgressBar()
        MapProgressBar.Visibility = Windows.Visibility.Hidden
        ShowMapButton.IsEnabled = True
    End Sub

    ' ShowMapButton click event handler.
    Private Sub ShowMapButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles ShowMapButton.Click
        If (AddressTxtBox.Text <> String.Empty) Then
            location = AddressTxtBox.Text.Replace(" ", "+")
            zoom = 15
            mapType = "roadmap"
            Dim geoThread As New Thread(AddressOf GetGeocodeData)
            geoThread.Start()

            ShowMapImage()
            AddressTxtBox.SelectAll()
            ShowMapButton.IsEnabled = False
            MapProgressBar.Visibility = Windows.Visibility.Visible

            If (RoadmapToggleButton.IsChecked = False) Then
                RoadmapToggleButton.IsChecked = True
                TerrainToggleButton.IsChecked = False
            End If
        Else
            MessageBox.Show("Enter location address.", _
                            "Map App", MessageBoxButton.OK, MessageBoxImage.Exclamation)
            AddressTxtBox.Focus()
        End If
    End Sub

    ' SaveFileDialog FileOk event handler.
    Private Sub saveDialog_FileOk(ByVal sender As Object, ByVal e As EventArgs)
        Dim td As New Thread(AddressOf SaveMap)
        td.Start()
    End Sub

    ' ZoomInButton click event handler.
    Private Sub ZoomInButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles ZoomInButton.Click
        ZoomIn()
    End Sub

    ' ZoomOutButton click event handler.
    Private Sub ZoomOutButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles ZoomOutButton.Click
        ZoomOut()
    End Sub

    ' SaveButton click event handler.
    Private Sub SaveButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles SaveButton.Click
        saveDialog.ShowDialog()
    End Sub

    ' RoadmapToggleButton Checked event handler.
    Private Sub RoadmapToggleButton_Checked(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles RoadmapToggleButton.Checked
        If (mapType <> "roadmap") Then
            mapType = "roadmap"
            ShowMapUsingLatLng()
            TerrainToggleButton.IsChecked = False
        End If
    End Sub

    ' TerrainToggleButton Checked event handler.
    Private Sub TerrainToggleButton_Checked(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles TerrainToggleButton.Checked
        If (mapType <> "terrain") Then
            mapType = "terrain"
            ShowMapUsingLatLng()
            RoadmapToggleButton.IsChecked = False
        End If
    End Sub

    Private Sub MapImage_MouseLeftButtonUp(ByVal sender As Object, ByVal e As System.Windows.Input.MouseButtonEventArgs) Handles MapImage.MouseLeftButtonUp
        If (location IsNot Nothing) Then
            Dim gMapURL As String = "http://maps.google.com/maps?q=" & location
            Process.Start("IExplore.exe", gMapURL)
        End If
    End Sub

    Private Sub Window1_Loaded(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles Me.Loaded
        AddressTxtBox.Focus()

        With saveDialog
            .DefaultExt = "png"
            .Title = "Save Map Image"
            .OverwritePrompt = True
            .Filter = "(*.png)|*.png"
        End With

        AddHandler saveDialog.FileOk, AddressOf saveDialog_FileOk
    End Sub

    Private Sub MinimizeButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles MinimizeButton.Click
        Me.WindowState = Windows.WindowState.Minimized
    End Sub

    Private Sub CloseButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles CloseButton.Click
        Me.Close()
    End Sub
//ds
    Private Sub BgndRectangle_MouseLeftButtonDown(ByVal sender As Object, ByVal e As System.Windows.Input.MouseButtonEventArgs) Handles BgndRectangle.MouseLeftButtonDown
        Me.DragMove()
    End Sub
//df
    Private Sub MoveUpButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles MoveUpButton.Click
        MoveUp()
    End Sub
//sdf
    Private Sub MoveDownButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles MoveDownButton.Click
        MoveDown()
    End Sub

    Private Sub MoveLeftButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles MoveLeftButton.Click
        MoveLeft()
    End Sub

    Private Sub MoveRightButton_Click(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles MoveRightButton.Click
        MoveRight()
    End Sub
   
End Class
&#13;
&#13;
&#13; 我有这个类通过谷歌地图搜索。 我如何将它传递给一个位置,以便在启动时它可以在地图上显示给定的位置?

1 个答案:

答案 0 :(得分:0)

WPF表单有一个加载的事件,你可以在那里添加一些代码来加载你的第一张地图:

Private Sub MainWindow_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
    ShowMapButton_Click(sender, e)
End Sub

在这种情况下,我将地址硬编码到AddressTxtBox中并调用Show Map。您可以添加为第一张地图设置条件所需的任何代码。

如果问题是“我如何将信息传递给首次加载时要使用的表单”,这是一个更短的帖子!

我对WPF没有太多的工作,所以我没有注意命名约定和最佳实践,所以请记住这一点......例如,被调用的表单不​​会被称为MainWindow!

在Winforms中可以使用这样的方法:

Public in_StartAddress As String = ""

Private Sub MainWindow_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
    If in_StartAddress.Length > 0 Then AddressTxtBox.Text = in_StartAddress
    ShowMapButton_Click(sender, e)
End Sub

' calling routine on another form
Private Sub Button_Click(sender As Object, e As RoutedEventArgs)
    Dim frm As New MainWindow
    frm.in_StartAddress = "1600 Pensylvania Ave, Washington DC"
    frm.Show()
    frm = Nothing
End Sub

查找有关将参数传递给新表单/窗口的帖子。