modgarmin.bas

用VB开发的巡检系统基于MAPINFo用VB开发的巡检系统基于MAPINFo很好的

'//deal with GPS data file (wcs)处理gps数据格式文件--Trackpoint
'//根据gps的数据进行处理，然后在地图上实时移动目标
'//数据：hddd°mm.mmm'
'//参数：Gps数据文件
Function DealWith_Gps_Trackpoint(ByVal pGpsID As String, ByVal tmpFile As String, ByVal pListView As MSComctlLib.ListView) As Double
    Dim strline As String, strHeadID As String, strChr() As String
    Dim lenStrLine As Integer, I As Integer, n As Integer, chrOne As String, cou As Integer
    Dim lngTpTag As Double
    Dim tp_num As Long '轨迹点个数
    Dim rs As New ADODB.Recordset, strSql As String, strInsert As String
    Dim tmpTrackFile As String '临时文件（待轨迹跟踪处理）
    Dim lstItem As MSComctlLib.ListItem
    
    Dim sTemp As String
    Dim mYear As String, mMonth As String, mDay As String, strYMD As String     '年月日
    Dim mHour As String, mMinute As String, mSecond As String, strHMS As String     '时分秒
    Dim sDateTime As String
    Dim mB As Integer, mB2 As Double
    Dim mL As Integer, mL2 As Double
    Dim dLatitude As Double, dLongitude As Double   '纬度、经度
    Dim mStar As Integer '星数
    
    ''######################刘登杰
    If tmpFile = "" Then '防止指定文件为空而无法打开
    MsgBox "请指定数据文件！", vbInformation + vbOKOnly, "提示"
    DealWith_Gps_Trackpoint = -9999 '返回错误处理数
    Exit Function
    End If
    
    On Error Resume Next
    Kill (App.Path + "\Track.tmp") '物理删除临时文件
   
    ''######################刘登杰
    
    On Error GoTo err_lab
    
    tp_num = 0
    tmpTrackFile = App.Path + "\Track.tmp"
    pListView.ListItems.Clear
    '打开文件进行处理
    Open tmpFile For Input As #1
    Open tmpTrackFile For Output As #2
      
    Print #2, pGpsID
    Do Until EOF(1)
        Line Input #1, strline
        strline = ReplaceReturn(strline)
        '============================================================================
        '解析信息串
        '//////////
        '开始处理数据($GPGGA)($GPRMC)
        If Mid$(strline, 1, 6) = "$GPRMC" Then   '取日期
            '$GPRMC,061317.000,V,4544.1113,N,12642.0065,E,,,030405,,*17
            
            '取年月日(源串\","的位置数)
            sTemp = ReadString_GPS_Package(strline, 9)
            mDay = Mid$(sTemp, 1, 2)
            mMonth = Mid$(sTemp, 3, 2)
            mYear = CStr(Val(2000 + Val(Mid$(sTemp, 5, 2))))
            'Debug.Print mYear & "-" & mMonth & "-" & mDay
            
            '取时分秒(源串\","的位置数)
            sTemp = ReadString_GPS_Package(strline, 1)
            mHour = Mid$(sTemp, 1, 2)
            '将UTC时间+8小时==>北京时间
            mHour = (Val(mHour) + 8) Mod 24 '''''''''''''################刘登杰
            
            mMinute = Mid$(sTemp, 3, 2)
            mSecond = Mid$(sTemp, 5, 2)
            'Debug.Print mHour & ":" & mMinute & ":" & mSecond
            
            '完整的接收日期和时间
            sDateTime = Format$(mYear, "00") & "-" & Format$(mMonth, "00") & "-" & Format$(mDay, "00") & " " & mHour & ":" & mMinute & ":" & mSecond
        
        ElseIf Mid$(strline, 1, 6) = "$GPGGA" Then   '取 时间、纬度、经度、星数
            '$GPGGA,061318.000,4544.1113,N,12642.0065,E,0,00,,,M,,M,,*4D
            '取纬度(源串\","的位置数)
            sTemp = ReadString_GPS_Package(strline, 2)
            'Debug.Print sTemp
            mB = Int(sTemp / 100) '纬度整数
            mB2 = 100 * ((sTemp / 100) - mB) / 60
            dLatitude = mB + mB2
            
            '取经度(源串\","的位置数)
            sTemp = ReadString_GPS_Package(strline, 4)
            'Debug.Print sTemp
            mL = Int(sTemp / 100) '经度整数
            mL2 = 100 * ((sTemp / 100) - mL) / 60 '分转成度
            dLongitude = mL + mL2
            
            '取星数
            sTemp = ReadString_GPS_Package(strline, 7)
            mStar = Val(sTemp)
            
'            '显示接收的数据包
'            Text3(0).Text = dLongitude
'            Text3(1).Text = dLatitude
'            Text3(2).Text = sDateTime
'            Text3(3).Text = mStar
            
            lngTpTag = Format(sDateTime, "YYYYMMDDHHMMSS")
            
            '展绘接收到的GPS点
            'CreatePoint CSng(dLongitude), CSng(dLatitude)  '参数为经度、纬度
            
            '星数大于3以上才存储数据
            If mStar >= 3 Then
                '============================================================================
                '将信息写入数据库
                '写入信息库(判断是否已经处理过当前的数据)
                Set rs = Nothing
                strSql = "select * from tbl_GPS_RecData where GpsID='" & pGpsID & "' and tpTag=" & lngTpTag
                rs.Open strSql, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
                If rs.RecordCount > 0 Then
                    rs.Delete adAffectCurrent
                    strInsert = "Insert into tbl_GPS_RecData(GpsID,Latitude,Longitude,RecTime,Star,TpTag) values('" _
                            & pGpsID & "'," & dLatitude & "," & dLongitude & ",'" & sDateTime & "'," & mStar & "," & lngTpTag & ")"
                    gblCn.Execute strInsert
                Else
                    strInsert = "Insert into tbl_GPS_RecData(GpsID,Latitude,Longitude,RecTime,Star,TpTag) values('" _
                            & pGpsID & "'," & dLatitude & "," & dLongitude & ",'" & sDateTime & "'," & mStar & "," & lngTpTag & ")"
                    gblCn.Execute strInsert
                End If
                rs.Close
                '============================================================================
                tp_num = tp_num + 1
                
                '写入临时文件
                'Print #2, tp_num & "," & dLatitude & "," & dLongitude & "," & sRecTime
                Print #2, tp_num, dLatitude, dLongitude, sDateTime
                 
                '写入listview
                With pListView
                    Set lstItem = .ListItems.Add(, , tp_num)
                    lstItem.SubItems(1) = dLongitude
                    lstItem.SubItems(2) = dLatitude
                    lstItem.SubItems(3) = sDateTime
                End With
            End If
        End If
    Loop
    Close #1
    Close #2
 
    ''#################刘登杰
    tmpFile = "" ' 释放空间，备其他程序正确调用
    
    bchuli = True
 
     ''#################刘登杰
     
     
    DealWith_Gps_Trackpoint = tp_num
    Exit Function
err_lab:
    MsgBox Err.Description, vbInformation, "提示"
    
    '###刘登杰
    '如果文件打开，关闭文件
    
    On Error Resume Next
    Close #1
    Close #2
      '###刘登杰
    DealWith_Gps_Trackpoint = -9999
End Function
                

'//判断点是否在当前窗口范围内，如果在则返回true,否则返回false
Function bInPolygon_Window(ByVal pLong As Single, pLat As Single) As Boolean
    Dim mMinX As Single, mMinY As Single, mMaxX As Single, mMaxY As Single
    mMinX = MapInfo.Eval("MapperInfo(" & mapWinID & "," & MAPPER_INFO_MINX & ")")
    mMinY = MapInfo.Eval("MapperInfo(" & mapWinID & "," & MAPPER_INFO_MINY & ")")
    mMaxX = MapInfo.Eval("MapperInfo(" & mapWinID & "," & MAPPER_INFO_MAXX & ")")
    mMaxY = MapInfo.Eval("MapperInfo(" & mapWinID & "," & MAPPER_INFO_MAXY & ")")
    'Debug.Print mMinX, mMinY, mMaxX, maxy
    If (pLong > mMinX And pLong < mMaxX) And (pLat > mMinY And pLat < mMaxY) Then
        bInPolygon_Window = True
    Else
        bInPolygon_Window = False
    End If
End Function

'去掉换行
Function ReplaceReturn(ByVal s As String) As String
    Dim lg As Integer, I As Integer, ss As String
    lg = Len(s)
    For I = 1 To lg
        If Asc(Mid$(s, I, 1)) = 10 Then
            
        Else
            ss = ss & Mid$(s, I, 1)
        End If
    Next
    'Debug.Print ss
    ReplaceReturn = ss
End Function