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

在帖子：VB读取、显示、保存、回放GPS数据的源程序

http://www.gisempire.com/bbs/dispbbs.asp?boardID=13;ID=18641;page=1

的基础上，对其进行简单的处理就可实现地图上的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

当然还需要建立一个用于显示地图的表单 frmMain，其地图控件为 mapMain

上述代码中注释少了点，如有不明白的地方，我再解释

3x,顶

强啊!

根据地图的坐标系(WGS84 or BJ54)来，显示GPS坐标的改进。(就是第1帖中空的那个判断语句)

                   If mapDest.NumericCoordSys.Units = miUnitDegree Then '度                         mobileFtr.Point.Set DD_X, DD_Y                     Else '米 BJ54坐标系                         '经纬度BL换算到高斯平面直角坐标XY（高斯投影正算）                         Deg2XY DD_X, DD_Y, CC_X, CC_Y                         mobileFtr.Point.Set CC_X, CC_Y                     End If