transfun.bas

GPS测量数据处理源码

Attribute VB_Name = "modTransFun"
Option Explicit
Public sArray() As String
Public sCnt As Integer

Public Function DM2DD(DegreeMinutes As String) As Double
'转换NMEA协议的“度分”格式为十进制“度度”格式，这是由具体任务决定的
'有些情况下可能需转换成其他坐标格式，这里只是一个演示而已
Dim Utils As New CParseUtils
Dim sDegree As String
Dim sMinute As String

    If IsNumeric(DegreeMinutes) And Utils.CountParts(DegreeMinutes, ".") = 2 Then
            If Len(Utils.Parse(DegreeMinutes, 1, ".")) = 4 Then
                DM2DD = CByte(Left(Utils.Parse(DegreeMinutes, 1, "."), 2)) + (CDbl(Right(DegreeMinutes, Len(DegreeMinutes) - 2)) / 60)
            End If
            
            If Len(Utils.Parse(DegreeMinutes, 1, ".")) = 5 Then
                DM2DD = CByte(Left(Utils.Parse(DegreeMinutes, 1, "."), 3)) + (CDbl(Right(DegreeMinutes, Len(DegreeMinutes) - 3)) / 60)
            End If
    End If
    
        Set Utils = Nothing
End Function
Public Sub playNMEA(sArray As Variant)
'读取存有GPS信息的回放文件
Dim rmc As GPRMC
Dim Utils As New CParseUtils
Dim Sentence As Integer

Dim yy As String, mm1 As String, dd As String   '年、月、日
Dim hh As String, mm2 As String, ss As String   '时、分、秒
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
                frmGPS_Disp.lblX.Caption = "X: " & Format(DM2DD(.Longitude), "000.0000") & " " & .LonHemis
                frmGPS_Disp.lblY.Caption = "Y: " & Format(DM2DD(.Latitude), "  00.0000") & " " & .LatHemis
                '去除速度前的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