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

你是否看过电影里那高科技呢?当军方在搜索恐怖分子的时候经常会通过卫星定位或手机信号定位到其精准的地理位置,现在使用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

 

 

评论 26
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值