'经纬度BL换算到高斯平面直角坐标XY（高斯投影正算）
Private Function Deg2XY(ByRef F2 As Double, ByRef E2 As Double, _
               ByRef s2 As Double, ByRef t2 As Double) As Boolean
               'A2 输入中央子午线，以度.分秒形式输入，如115度30分则输入115.30; 起算数据L0
               'F2 以度小数形式输入经度值, L
               'E2 以度小数形式输入纬度值，B
               'S2 计算结果，横坐标Y,,请特别注意，这里生成的是高斯坐标
               'T2 计算结果，纵坐标X
               '投影带号计算　n=[L/6]+1   如：兰州测得经度103.XXXX，故n=[103.X/6]+1=17+1=18
               '中央经线经度　L0 = n*6-3 = [L/6]*6+3
               
   'ByRef A2 As Double,
   Dim A2 As Double
   Dim B2 As Double
   'Dim G2 As Double
   Dim H2 As Double
   Dim i2 As Double
   Dim J2 As Double
   Dim K2 As Double
   Dim l2 As Double
   Dim M2 As Double
   Dim n2 As Double
   Dim O2 As Double
   Dim P2 As Double
   Dim Q2 As Double
   Dim R2 As Double
   Dim NN As Integer '投影代号
'    A2 = CInt(F2 / 6) * 6 - 3
   
'    B2 = Int(A2) + (Int(A2 * 100) - Int(A2) * 100) / 60 + (A2 * 10000 - Int(A2 * 100) * 100) / 3600
   '把L0化成度(A2)
   NN = CInt(F2 / 6) + 1 '投影代号n=[L/6]+1 '
   B2 = NN * 6 - 3 '中央经线
   'G2 = F2 - B2 ' L -L0
   'H2 = G2 / 57.2957795130823 '化作弧度
   H2 = (F2 - B2) / 57.2957795130823 '将经差的单位化为弧度
   i2 = Tan(E2 / 57.2957795130823) 'Tan (B)
   J2 = Cos(E2 / 57.2957795130823) ' Cos (B)
   K2 = 0.006738525415 * J2 * J2
   l2 = i2 * i2
   M2 = 1 + K2
   n2 = 6399698.9018 / Sqr(M2)
   O2 = H2 * H2 * J2 * J2
   P2 = i2 * J2
   Q2 = P2 * P2
   R2 = (32005.78006 + Q2 * (133.92133 + Q2 * 0.7031))
   s2 = ((((l2 - 18) * l2 - (58 * l2 - 14) * K2 + 5) * O2 / 20 + M2 - l2) * O2 / 6 + 1) * n2 * (H2 * J2)
   
   '计算结果,横坐标Y，这里生成的是高斯坐标
   s2 = s2 + NN * 1000000 + 500000 '18500000 '在计算的基础上加上了“带号”（18）和“东移”（500KM）
   '计算结果，纵坐标X
   t2 = 6367558.49686 * E2 / 57.29577951308 - P2 * J2 * R2 + ((((l2 - 58) * l2 + 61) * _
       O2 / 30 + (4 * K2 + 5) * M2 - l2) * O2 / 12 + 1) * n2 * i2 * O2 / 2
   
   Deg2XY = True
End Function

版主，菜菜的问一下，为什么回放的时候所有的点都显示在TEMPLATE层上？

怎么实现只显示一个点的移动呢？而且回放结束以后，所有的点信息仍然保存在TEMPLATE层上，怎么清空呢？

可以修改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点

版主，还要麻烦你一下，请问，怎样实现程序里的时间和电脑的时钟同步呢？

回放的速度太快了。。。还没看清除就结束了。。。

请问应该在哪加一个时间控制语句？可不可以根据数据里的时间同步显示呢？