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

原创 2011年01月07日 17:46:00

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

 

 

Delphi7高级应用开发随书源码

  • 2003年04月30日 00:00
  • 676KB
  • 下载

VB中实现地图操作的方法

1.       在VB的Form设计时,加入一个picturebox控件,这个控件作为OLE容器,MapInfo中的地图将在该控件上显示。2.       执行VB的函数Createobject(“...

Delphi7高级应用开发随书源码

  • 2003年04月30日 00:00
  • 676KB
  • 下载

[进阶]往Google Earth里导入现有数据

转自:http://www.godeyes.cn/html/2008/08/23/google_earth_56.html  用 Google Earth 的导入功能可以将用户自定义的地理数...

用AE实现google earth的导航与跟踪条控制地图比例

在坛子上问了两天,结果没有人回答,心寒,没办法,靠自己。。嘿嘿,最后竟然也让我解决了。。开心一个。下面把代码贴一下。 首先是地图向上,向下,向左,向右代码的实现: private void btrig...

VB.NET 中嵌入Google earth 并实现gps实时定位

用到了Google earth api 和VB,NET  VB code如下 Imports System Imports System.Collections.Generic Imports Sy...

利用 Google Earth实现 GPS实时定位跟踪 实时显示

版权所有:转载请注明 中北大学 K.B

VB GPS卫星定位

  • 2010年04月11日 21:16
  • 46KB
  • 下载

[GitHub开源]基于HTML5实现的轻量级Google Earth三维地图引擎,带你畅游世界

A WebGL virtual globe and map engine WebGlobe WebGlobe是基于HTML5原生WebGL实现的轻量级Google Earth三维地图...

如何下载谷歌地球(Google Earth)中的卫星地图

一、准备工作 安装水经注万能地图下载器,如果没有安装本软件,可以百度“水经注软件”到官方网站下载。 二、下载地图 这里以下载“四川省”谷歌地球中的卫星地图为例。 启动水经注万能地图下载器,...
  • mrib
  • mrib
  • 2015年04月22日 14:14
  • 2002
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:VB实现GPS卫星定位及地图显示 Google Earth
举报原因:
原因补充:

(最多只允许输入30个字)