关闭

VB实现GPS卫星定位及地图显示 Google Earth

标签: googlevbtimerstringwebbrowserfunction
8882人阅读 评论(22) 收藏 举报

你是否看过电影里那高科技呢?当军方在搜索恐怖分子的时候经常会通过卫星定位或手机信号定位到其精准的地理位置,现在使用Google Earth和Google Maps提供的接口,你也可以实现这样的功能,误差距离不超过20米(取决于GPS的等级)

 

首先你需要安装Google Earth,并且确保网络畅通。为了保证刷新的频率不要太高,我们使用Timer定时刷新页面,时间为10s。

 

 

最后的效果如图显示,关于GPS指令请查阅相关资料。

Public Class Form1
    Dim buf As String
    Dim txtbuf(15) As String
    Dim NSEW As String
    Dim APPGE As New EARTHLib.ApplicationGE
    Dim SGE As New EARTHLib.SearchControllerGE

    Private Sub Form1_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
    End Sub
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.SerialPort1.Open()
        Me.CheckForIllegalCrossThreadCalls = False
        buf = ""
        Me.Show()
        GetGoogleSnapHost()
    End Sub

    Private Sub SerialPort1_DataReceived(ByVal sender As Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles SerialPort1.DataReceived
        On Error Resume Next
        Me.txtbuf = Nothing
        buf = buf & Chr(Me.SerialPort1.ReadByte)
        If Strings.Right(buf, 2) = Chr(13) & Chr(10) Then
            If Strings.Left(buf, 6) = "$GPGGA" Then
                txtbuf = Strings.Split(buf, ",")
                Me.TextBox1.Text = Me.txtbuf(1)
                Me.TextBox2.Text = Me.txtbuf(2)
                Me.TextBox3.Text = Me.txtbuf(3)
                Me.TextBox4.Text = Me.txtbuf(4)
                Me.TextBox5.Text = Me.txtbuf(5)
                Me.TextBox6.Text = Me.txtbuf(6)
                Me.TextBox7.Text = Me.txtbuf(7)
                Me.TextBox8.Text = Me.txtbuf(8)
                Me.TextBox9.Text = Me.txtbuf(9) & Me.txtbuf(10)
                Me.TextBox10.Text = Me.txtbuf(11) & Me.txtbuf(12)
                If txtbuf(6) = "1" Then
                    NSEW = Me.GetGoogleEartAddr(Me.txtbuf(2), Me.txtbuf(4))
                    Me.TextBox11.Text = NSEW

                End If
               

            End If
            Me.AxiLedRoundX1.Active = Not Me.AxiLedRoundX1.Active
            buf = ""
            Me.SerialPort1.Close()
            Me.SerialPort1.Open()
        End If
    End Sub

    Public Function GetGoogleEartAddr(ByVal opt1 As String, ByVal opt2 As String) As String
        Dim dtmp(4) As Double
        dtmp(0) = Int(Val(opt1) / 100)
        dtmp(1) = (Val(opt1) / 100 - dtmp(0)) * 100 / 60
        dtmp(2) = Int(Val(opt2) / 100)
        dtmp(3) = (Val(opt2) / 100 - dtmp(2)) * 100 / 60
        Return dtmp(0) + dtmp(1) & "," & dtmp(2) + dtmp(3)
    End Function

    Public Sub GetGoogleSnapHost()
        Me.APPGE.SaveScreenShot("F:/GoogleMapsTmp.jpg", 100)
        While Not IO.File.Exists("F:/GoogleMapsTmp.jpg")
            Application.DoEvents()
        End While
        For i = 0 To 1000
            Application.DoEvents()
        Next
        Dim img As Image
        Dim bufdata() As Byte
        bufdata = FileIO.FileSystem.ReadAllBytes("F:/GoogleMapsTmp.jpg")
        Dim wo As New IO.MemoryStream(bufdata)
        img = Image.FromStream(wo)
        Me.Panel1.BackgroundImage = img
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick

        GetGoogleSnapHost()
        SGE.Search(Me.NSEW)

        Me.WebBrowser1.Navigate("")
        For i = 0 To 100
            Application.DoEvents()
        Next
        Me.WebBrowser1.Document.Write(Me.TextBox12.Text.Replace("31.8063916666667,121.660626666667", Me.NSEW))
        For i = 0 To 100
            Application.DoEvents()
        Next
        Me.WebBrowser1.Refresh()
    End Sub

    Private Sub WebBrowser1_DocumentCompleted(ByVal sender As System.Object, ByVal e As System.Windows.Forms.WebBrowserDocumentCompletedEventArgs)

    End Sub

    Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick
        Me.ProgressBar1.Value += 10
        If Me.ProgressBar1.Value = 100 Then Me.ProgressBar1.Value = 0
    End Sub
End Class

 

 

2
0

查看评论
* 以上用户言论只代表其个人观点,不代表CSDN网站的观点或立场
    个人资料
    • 访问:92313次
    • 积分:1263
    • 等级:
    • 排名:千里之外
    • 原创:32篇
    • 转载:1篇
    • 译文:0篇
    • 评论:44条
    最新评论