VB＋MapX 实现地图上GPS数据显示（GPS＋GIS）

楼主^#

更多发布于：2004-09-05 21:46

在帖子：VB读取、显示、保存、回放GPS数据的源程序
<a href="http://www.gisempire.com/bbs/dispbbs.asp?boardID=13;ID=18641;page=1" target="_blank" >http://www.gisempire.com/bbs/dispbbs.asp?boardID=13;ID=18641;page=1</A>
的基础上，对其进行简单的处理就可实现地图上的GPS数据显示。
只需对显示模块modTransFun中的进行修改即可，具体实现部分自己看吧：
Public Sub playNMEA(sArray As Variant)
'读取存有GPS信息的回放文件
Dim rmc As GPRMC
Dim Utils As New CParseUtils
Dim Sentence As Integer
Dim mapDest As MapXLib.Map
Dim mobileObj As New MapXLib.Feature
Dim mobileFtr As New MapXLib.Feature
Dim lnFeat As New MapXLib.Feature
Dim FeatFact As MapXLib.FeatureFactory
Dim GPSPoints As New MapXLib.Points, aPoint As New MapXLib.Point
Dim NewStyle As New Style
Dim GPSLayerID As Integer
Dim intReg As Integer
Dim DD_X As Double, DD_Y As Double

Dim yy As String, mm1 As String, dd As String '年、月、日
Dim hh As String, mm2 As String, ss As String '时、分、秒
intReg = 0.00012
Set mapDest = frmMain.mapMain '这里是用于显示地图的表单及控件名
GPSLayerID = 1 'mapDest.Layers.Count
Set mapDest.Layers.AnimationLayer = mapDest.Layers(GPSLayerID)
mobileFtr.Attach mapDest
mobileFtr.Type = miFeatureTypeSymbol
'mobileFtr.Style = mapDest.DefaultStyle
With NewStyle
 .SymbolFont.Name = "Mapinfo symbols"
 .SymbolCharacter = 50 ';H40 '塔符号0X40,圆形符号0X2F
 .SymbolFont.Size = 4 ' set the size of the symbol to be 18...
 .SymbolFontRotation = 0
 .SymbolFontShadow = False
 .SymbolFontHalo = False ' turn Halo effect on...
 .SymbolFontColor = vbRed ' 红...
 .SymbolFontBackColor = miColorWhite ' change the Halo color to White
End With
mobileFtr.Style = NewStyle
For Sentence = 0 To sCnt - 1
 If Utils.Parse(sArray(Sentence), 1) = "$GPRMC" Then
 Set rmc = New GPRMC
 DoEvents
 With rmc
 .Sentence = sArray(Sentence)
 If Not Val(.Longitude) = 0 Then
 DD_X = DM2DD(.Longitude)
 DD_Y = DM2DD(.Latitude)
 frmGPS_Disp.lblX.Caption = "X: " ; Format(DD_X, "000.0000") ; " " ; .LonHemis
 frmGPS_Disp.lblY.Caption = "Y: " ; Format(DD_Y, " 00.0000") ; " " ; .LatHemis

 If mapDest.MapUnit = miUnitDegree Then

 Else

 End If
 mobileFtr.Point.Set DD_X, DD_Y
 Set mobileObj = mapDest.Layers(GPSLayerID).AddFeature(mobileFtr)

 mapDest.Layers(GPSLayerID).Refresh

 If mobileFtr.Point.X > mapDest.Bounds.XMAX - intReg Or _
 mobileFtr.Point.X < mapDest.Bounds.XMin + intReg Or _
 mobileFtr.Point.Y > mapDest.Bounds.YMAX - intReg Or _
 mobileFtr.Point.Y < mapDest.Bounds.YMin + intReg Then

 mapDest.CenterX = mobileFtr.Point.X
 mapDest.CenterY = mobileFtr.Point.Y
 End If

 '去除速度前的0
 frmGPS_Disp.lblSpeed.Caption = "速度: " ; Val(.Speed) ; " Km/h"
 '日期的格式转换: 250503 -> 03/05/25
 dd = Mid$(.UTDate, 1, 2)
 mm1 = Mid$(.UTDate, 3, 2)
 yy = Mid$(.UTDate, 5, 2)
 frmGPS_Disp.lblDate.Caption = "日期: " ; Format(yy + mm1 + dd, "00/00/00")
 'UTC时间转换为北京时间
 hh = Mid$(.UTC, 1, 2) + 8
 mm2 = Mid$(.UTC, 3, 2)
 ss = Mid$(.UTC, 5, 2)
 frmGPS_Disp.lblUTC.Caption = "时间: " ; Format(hh + mm2 + ss, "00:00:00")
 Else
 MsgBox "接收卫星太少，不能定位！"

 frmGPS_Disp.lblX.Caption = "X: "
 frmGPS_Disp.lblY.Caption = "Y: "
 frmGPS_Disp.lblSpeed.Caption = "速度: "
 frmGPS_Disp.lblDate.Caption = "日期: "
 frmGPS_Disp.lblUTC.Caption = "时间: "

 Exit Sub
 End If

 End With
 End If
Next Sentence
End Sub

[此贴子已经被作者于2004-9-5 21:58:23编辑过]

喜欢0 评分0

网站: www.52xoo.com (3S,信息融合,数字图像处理,模式识别与人工智能等专业电子书、学术文章及源代码共享) E-mail: Jianhong72@163.com QQ: 88128745 (55359982用了近10年，最近被盗了，郁闷！！！)

举报回复

miaoaichong 路人甲注册日期2008-08-11 发帖数2 QQ 铜币108枚威望0点贡献值0点银元0个加关注写私信	1楼^# 发布于：2008-08-15 09:14 <FONT face=宋体>刚接触mapx的新手，想要实现远程的GPS在监控中心的电子地图上定位，请问下怎么使用mapx控件以及VB在地图上显示接收到的GPS数据（经纬度）啊？查了好多天资料也没想明白，明白的指导下！谢谢了！</FONT>
	举报回复(0) 喜欢(0) 评分

wangjh

论坛版主

注册日期2003-08-22
发帖数994
QQ55359982
铜币2579枚
威望0点
贡献值0点
银元0个

加关注写私信

2楼^#

发布于：2005-08-14 17:31

<DIV class=quote>以下是引用zhgj1728在2005-7-27 9:29:37的发言： 老大能不能上传一份测试的图阿，谢谢！</DIV>
<a href="attachment/2005-8/200581417301923624.rar">2005-8/200581417301923624.rar</a>　<<<<<<上传了测试数据。 
<a href="http://www.gisempire.com/bbs/dispbbs.asp?boardID=13;ID=42720;page=1" target="_blank" >http://www.gisempire.com/bbs/dispbbs.asp?boardID=13;ID=42720;page=1</A>　
帖子上有更精减的示例代码和测试数据

网站: www.52xoo.com (3S,信息融合,数字图像处理,模式识别与人工智能等专业电子书、学术文章及源代码共享) E-mail: Jianhong72@163.com QQ: 88128745 (55359982用了近10年，最近被盗了，郁闷！！！)

举报回复喜欢评分

zhuzhai 路人甲注册日期2005-08-06 发帖数12 QQ 铜币130枚威望0点贡献值0点银元0个加关注写私信	3楼^# 发布于：2005-08-14 14:26 <img src="images/post/smile/dvbbs/em08.gif" />
	举报回复(0) 喜欢(0) 评分

zhgj1728 路人甲注册日期2003-12-03 发帖数14 QQ 铜币148枚威望0点贡献值0点银元0个加关注写私信	4楼^# 发布于：2005-07-27 09:29 老大能不能上传一份测试的图阿，谢谢！
	举报回复(0) 喜欢(0) 评分

nhczp 路人甲注册日期2005-07-25 发帖数24 QQ 铜币151枚威望0点贡献值0点银元0个加关注写私信	5楼^# 发布于：2005-07-27 07:52 <img src="images/post/smile/dvbbs/em02.gif" />
	举报回复(0) 喜欢(0) 评分

cxb003 路人甲注册日期2004-11-23 发帖数12 QQ 铜币142枚威望0点贡献值0点银元0个加关注写私信	6楼^# 发布于：2005-07-26 10:37 版主就是大好人
	举报回复(0) 喜欢(0) 评分

gyhcly 路人甲注册日期2005-06-09 发帖数10 QQ 铜币125枚威望0点贡献值0点银元0个加关注写私信	7楼^# 发布于：2005-06-17 00:25 <P>版主，还要麻烦你一下，请问，怎样实现程序里的时间和电脑的时钟同步呢？</P> <P>回放的速度太快了。。。还没看清除就结束了。。。</P> <P>请问应该在哪加一个时间控制语句？可不可以根据数据里的时间同步显示呢？</P>
	举报回复(0) 喜欢(0) 评分

gyhcly 路人甲注册日期2005-06-09 发帖数10 QQ 铜币125枚威望0点贡献值0点银元0个加关注写私信	8楼^# 发布于：2005-06-16 22:22 太感谢版主了，谢谢谢谢谢谢
	举报回复(0) 喜欢(0) 评分

wangjh

论坛版主

注册日期2003-08-22
发帖数994
QQ55359982
铜币2579枚
威望0点
贡献值0点
银元0个

加关注写私信

9楼^#

发布于：2005-06-16 19:23

<DIV class=quote>以下是引用gyhcly在2005-6-15 23:31:59的发言： 
版主，菜菜的问一下，为什么回放的时候所有的点都显示在TEMPLATE层上？
怎么实现只显示一个点的移动呢？而且回放结束以后，所有的点信息仍然保存在TEMPLATE层上，怎么清空呢？</DIV>
可以修改playNMEA函数，删除前面的图元
Public Sub playNMEA(sArray As Variant) '读取存有GPS信息的回放文件 Dim rmc As GPRMC Dim Utils As New CParseUtils Dim Sentence As Integer Dim mapDest As MapXLib.Map Dim mobileObj As New MapXLib.Feature Dim mobileFtr As New MapXLib.Feature Dim lnFeat As New MapXLib.Feature Dim FeatFact As MapXLib.FeatureFactory Dim GPSPoints As New MapXLib.Points, aPoint As New MapXLib.Point Dim NewStyle As New Style Dim GPSLayerID As Integer Dim intReg As Integer Dim DD_X As Double, DD_Y As Double Dim BJ_X As Double, BJ_Y As Double Dim yy As String, mm1 As String, dd As String '年、月、日 Dim hh As String, mm2 As String, ss As String '时、分、秒 Dim ftrID As Long intReg = 0.00012 Set mapDest = frmGPS_Disp.mapMain '这里是用于显示地图的表单及控件名 GPSLayerID = 1 'mapDest.Layers.Count ftrID = 1
 If mapDest.Layers.Count > 1 Then Set mapDest.Layers.AnimationLayer = mapDest.Layers(GPSLayerID) Else MsgBox "没有地图，请先打开地图！" Exit Sub End If mobileFtr.Attach mapDest mobileFtr.Type = miFeatureTypeSymbol With NewStyle .SymbolFont.Name = "Mapinfo symbols" .SymbolCharacter = 50 ';H40 '塔符号0X40,圆形符号0X2F .SymbolFont.Size = 10 ' 设置符号大小 .SymbolFontRotation = 0 .SymbolFontShadow = False .SymbolFontHalo = False .SymbolFontColor = 255 ' 定义为红色... .SymbolFontBackColor = miColorWhite End With mobileFtr.Style = NewStyle mobileFtr.Point.Set 0, 0 Set mobileObj = mapDest.Layers(GPSLayerID).AddFeature(mobileFtr) For Sentence = 0 To sCnt - 1 If Utils.Parse(sArray(Sentence), 1) = "$GPRMC" Then Set rmc = New GPRMC DoEvents With rmc .Sentence = sArray(Sentence) If Not Val(.Longitude) = 0 Then DD_X = DM2DD(.Longitude) DD_Y = DM2DD(.Latitude) frmGPS_Disp.lblX.Caption = "X: " ; Format(DM2DD(.Longitude), "000.0000") ; " " ; .LonHemis frmGPS_Disp.lblY.Caption = "Y: " ; Format(DM2DD(.Latitude), " 00.0000") ; " " ; .LatHemis If bDispType = 1 Then 'bDispType为显示类型，1－－单点显示 mapDest.Layers.Item("GPSLayer").DeleteFeature ftrID '清除以前的图元 End If If mapDest.NumericCoordSys.Units = miUnitDegree Then '度 mobileFtr.Point.Set DD_X, DD_Y Else '米 BJ54坐标系 '经纬度BL换算到高斯平面直角坐标XY（高斯投影正算） Deg2XY DD_X, DD_Y, BJ_X, BJ_Y mobileFtr.Point.Set BJ_X, BJ_Y End If Set mobileObj = mapDest.Layers(GPSLayerID).AddFeature(mobileFtr) ftrID = mobileObj.FeatureID 'mapDest.Layers(GPSLayerID).Refresh If mobileFtr.Point.X > mapDest.Bounds.XMax - intReg Or _ mobileFtr.Point.X < mapDest.Bounds.XMin + intReg Or _ mobileFtr.Point.Y > mapDest.Bounds.YMax - intReg Or _ mobileFtr.Point.Y < mapDest.Bounds.YMin + intReg Then mapDest.CenterX = mobileFtr.Point.X mapDest.CenterY = mobileFtr.Point.Y End If frmGPS_Disp.lblSpeed.Caption = "速度: " ; Val(.Speed) ; " Km/h" '日期的格式转换: 250503 -> 03/05/25 dd = Mid$(.UTDate, 1, 2) mm1 = Mid$(.UTDate, 3, 2) yy = Mid$(.UTDate, 5, 2) frmGPS_Disp.lblDate.Caption = "日期: " ; Format(yy + mm1 + dd, "00/00/00") 'UTC时间转换为北京时间 hh = Mid$(.UTC, 1, 2) + 8 mm2 = Mid$(.UTC, 3, 2) ss = Mid$(.UTC, 5, 2) frmGPS_Disp.lblUTC.Caption = "时间: " ; Format(hh + mm2 + ss, "00:00:00") Else MsgBox "接收卫星太少，不能定位！" frmGPS_Disp.lblX.Caption = "X: " frmGPS_Disp.lblY.Caption = "Y: " frmGPS_Disp.lblSpeed.Caption = "速度: " frmGPS_Disp.lblDate.Caption = "日期: " frmGPS_Disp.lblUTC.Caption = "时间: " Exit Sub End If End With End If Next Sentence Set mapDest = Nothing Set mobileObj = Nothing Set mobileFtr = Nothing Set lnFeat = Nothing Set FeatFact = Nothing Set GPSPoints = Nothing Set NewStyle = Nothing End Sub
本程序中，指定了一个名为“GPSLayer”临时图层，用于显示GPS点

网站: www.52xoo.com (3S,信息融合,数字图像处理,模式识别与人工智能等专业电子书、学术文章及源代码共享) E-mail: Jianhong72@163.com QQ: 88128745 (55359982用了近10年，最近被盗了，郁闷！！！)

举报回复喜欢评分

您需要登录后才可以回帖，登录或者注册

VB＋MapX 实现地图上GPS数据显示（GPS＋GIS）

最新喜欢：