frmgpstrack.frm

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

    '删除临时表的记录
    'MapInfo.Do "delete from " & TableName
    'SaveTable TableName
    'MapInfo.Do "Pack Table " & TableName & " Graphic Data"
    '加载临时图层到当前的
    MapInfo.Do "Add Map Layer " & TableName
    '-------------------------------------------------------------
    MapInfo.Do "set map Redraw On"
    MapInfo.Do "set map Zoom 0.5"
    
    '符号
    MapInfo.Do "Set Style Symbol MakeSymbol(34,8388608 ,9)"
    
    '//监测数据
    Call_GPS_InformationB ByVal lpDeviceID
    
    Exit Sub
Err_NoPort:
    Me.Command1.Enabled = True
    Me.Command2.Enabled = False
    MsgBox Err.Description, vbCritical, "提示"
End Sub

Private Sub Command2_Click()
    Me.Command1.Enabled = True
    Me.Command2.Enabled = False
    StopContinue_Com False
    bCreateGpsDataFile = False
    Close
End Sub

Sub StopContinue_Com(ByVal bl As Boolean)
    MSComm1.PortOpen = bl
End Sub

Private Sub Command3_Click()
    Me.Command1.Enabled = True
    Me.Command2.Enabled = False
    bCreateGpsDataFile = False
    Close
    Unload Me
End Sub

Private Sub Command4_Click()
    Dim I As Integer
    Me.Text1.Text = ""
    For I = 0 To 3
        Me.Text3(I).Text = ""
    Next
End Sub

Private Sub Form_Load()
    Dim I As Integer
    For I = 1 To 8
        Me.Combo1.AddItem I
    Next
    Me.Combo2.AddItem "2400"
    Me.Combo2.AddItem "4800"
    Me.Combo2.AddItem "9600"
    Me.Combo2.AddItem "19200"
    Me.Combo2.AddItem "38400"
    Me.Combo2.AddItem "57600"
    Me.Combo2.AddItem "115200"
    
    Me.Combo1.Text = g_Com
    Me.Combo2.Text = g_BTL
    
    '加载GPSID
    Load_GpsID rs, Me.Combo3
    
    Me.Command1.Enabled = True
    Me.Command2.Enabled = False
    
    Me.Top = 0
    Me.Left = 0
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    If Me.WindowState = 1 Then Exit Sub
    Me.Height = 6345
    Me.Width = 6810
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Me.Command1.Enabled = True
    Me.Command2.Enabled = False
    'StopContinue_Com False
    bCreateGpsDataFile = False
    Close
    
    Cancel = 0
End Sub

'接收GPS数据
Sub Call_GPS_InformationB(ByVal tmpDeviceID As String)
    Dim Buffer As Variant
    Dim T As String
    Dim vT As Variant
    Dim SZ() As Byte
    Dim BAKSZ(1024) As Byte
    Static CT As Integer
    Static Check_Count As Long
    Dim kkkk As Integer
    Dim pDeviceID As String, pLong As Double, pLat As Double, pStar As Integer, pDate As String, pTime As String
    Dim strline As String
    
    Dim sTemp As String
    Dim strGps(1000) As String, n As Integer
    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 mLatitude As Double, mLongitude As Double   '纬度、经度
    Dim mStar As Integer '星数
    Dim tpTag As Double
    Dim strShowMsg As String
   
    Dim bRecInfo As Boolean '判断是否为接收数据包
    Dim sGpsDataFile As String
    Dim strInsert As String
    
    On Error GoTo err_lab
    Check_Count = 0
    
    pDeviceID = tmpDeviceID
    MSComm1.InputMode = comInputModeBinary
    MSComm1.InputLen = 1
    '等待直到输入缓冲区有 10 个字节
    Do
        DoEvents
        Do Until MSComm1.InBufferCount < 1
            vT = MSComm1.Input
            SZ = vT
            If SZ(0) = 13 Then
                strline = String(CT, " ")
                HMEMCPY ByVal strline, BAKSZ(0), ByVal CT
                CT = 0
                
                Check_Count = Check_Count + 1
                If Check_Count > 3000 Then
                    Text1.Text = ""
                    Check_Count = 0
                End If
                '//接收到的数据包
                Text1.Text = strline & vbCrLf & Text1.Text
                '============================================================================
                '解析信息串
                '//////////
                If Mid$(strline, 2, 6) = "$GPGGA" Then '取 时间、纬度、经度、星数
                
                    kkkk = kkkk + 1
                    '$GPGGA,061318.000,4544.1113,N,12642.0065,E,0,00,,,M,,M,,*4D
                    
                    Dim mB As Integer, mB2 As Double
                    Dim mL As Integer, mL2 As Double
                    
                    If kkkk > 2 Then
                        '取纬度(源串\","的位置数)
                        sTemp = ReadString_GPS_Package(strline, 2)
                        'Debug.Print sTemp
                        mB = Int(sTemp / 100) '纬度整数
                        mB2 = 100 * ((sTemp / 100) - mB) / 60
                        mLatitude = mB + mB2
                        
                        '取经度(源串\","的位置数)
                        sTemp = ReadString_GPS_Package(strline, 4)
                        'Debug.Print sTemp
                        mL = Int(sTemp / 100) '经度整数
                        mL2 = 100 * ((sTemp / 100) - mL) / 60 '分转成度
                        mLongitude = mL + mL2
                        
                        '取星数
                        sTemp = ReadString_GPS_Package(strline, 7)
                        mStar = Val(sTemp)
                        'mStar = 4
                        
                        bRecInfo = True
                        
                        If bCreateGpsDataFile Then
                            '去掉换行符
                            strline = ReplaceReturn(strline)
                            Print #1, strline
                        End If
                    End If
                ElseIf Mid$(strline, 2, 6) = "$GPRMC" Then
                    '开始处理数据($GPGGA)($GPRMC)
                    '$GPRMC,061317.000,V,4544.1113,N,12642.0065,E,,,030405,,*17
                    If kkkk > 2 Then
                        '取年月日(源串\","的位置数)
                        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
                        mMinute = Mid$(sTemp, 3, 2)
                        mSecond = Mid$(sTemp, 5, 2)
                        'Debug.Print mHour & ":" & mMinute & ":" & mSecond
                        
                        '月份和日期不能为空！
                        If mMonth <> "" And mDay <> "" Then
                            '完整的接收日期和时间
                            sDateTime = mYear & "-" & mMonth & "-" & mDay & " " & mHour & ":" & mMinute & ":" & mSecond
                            tpTag = Val(mYear & mMonth & mDay & mHour & mMinute & mSecond)
                            
                            '//生成GPS监测数据文件
                            If Not bCreateGpsDataFile Then
                                sGpsDataFile = tmpDeviceID & "-" & mYear & mMonth & mDay & "-" & mHour & mMinute & ".txt"
                                Open App.Path + "\Gps监测数据\" + sGpsDataFile For Output As #1
                                bCreateGpsDataFile = True
                            End If
                            '============================================================================
                            '将信息写入数据库
                            If bRecInfo Then
                                '显示接收的数据包
                                Text3(0).Text = mLongitude
                                Text3(1).Text = mLatitude
                                Text3(2).Text = sDateTime
                                Text3(3).Text = mStar
                                
                                '展点
                                CreatePoint CSng(mLongitude), CSng(mLatitude)  '参数为经度、纬度
                                '-----------------------------------------
                                '如果点不在当前窗口内,则就改变当前的中心点
                                If Not bInPolygon_Window(CSng(mLongitude), CSng(mLatitude)) Then
                                    MapInfo.Do "Set map Center (" & mLongitude & "," & mLatitude & ")"
                                End If
        '                        '展绘轨迹线
        '                        If I = 2 Then
        '                            '绘第一个点
        '                            m_preLong = dLongitude
        '                            m_preLat = dLatitude
        '                        ElseIf I > 2 Then
        '                            '绘第二个点和以后的点
        '                            m_curLong = dLongitude
        '                            m_curLat = dLatitude
        '
        '                            '画线(两点间创建直线)
        '                            CreateLine m_preLong, m_preLat, m_curLong, m_curLat
        '
        '                            '将当前点记录为前一点
        '                            m_preLong = m_curLong
        '                            m_preLat = m_curLat
        '                        End If
                                
                                If mStar >= 3 Then
                                    strInsert = "insert into tbl_Gps_RecData(GpsID,Latitude,Longitude,RecTime,Star,tpTag) values('" _
                                        & pDeviceID & "'," & mLatitude & "," & mLongitude & ",#" & sDateTime & "#," & mStar & "," & tpTag & ")"
                                    gblCn.Execute strInsert
                                End If
                                
                                If bCreateGpsDataFile Then
                                    '写入监测数据文件
                                    strline = ReplaceReturn(strline) '去掉换行符
                                    Print #1, strline
                                    bRecInfo = False
                                End If
                            End If
                        End If
                    End If
                    '============================================================================
                End If
                strline = ""
            ElseIf SZ(0) <> 130 Then
                BAKSZ(CT) = SZ(0)
                CT = CT + 1
            End If
        Loop
    Loop
    Exit Sub
err_lab:
    kkkk = 0
    Me.Command1.Enabled = True
    Me.Command2.Enabled = False
    StopContinue_Com False
    'Command2.Caption = "继续(&C)"
    Close #1
    MsgBox Err.Description, vbInformation, "提示"
End Sub




'//解析纬度 wcs
Function GetNumeric_N(ByVal sT As String) As String
    Dim I As Integer, lg As Integer, chrLine As String, tmpLine As String, bl As Boolean
    lg = Len(sT)
    For I = 1 To lg
        chrLine = Mid$(sT, I, 1)
        If chrLine = "N" Then
            bl = True
        End If
        If bl Then
            GetNumeric_N = Mid$(sT, I + 1, 7)
            Exit For
        End If
    Next
End Function

'//解析经度 wcs
Function GetNumeric_E(ByVal sT As String) As String
    Dim I As Integer, lg As Integer, chrLine As String, tmpLine As String, bl As Boolean
    lg = Len(sT)
    For I = 1 To lg
        chrLine = Mid$(sT, I, 1)
        If chrLine = "E" Then
            bl = True
        End If
        If bl Then
            GetNumeric_E = Mid$(sT, I + 1, 8)
            Exit For
        End If
    Next
End Function

Function SpaceGPSData(ByVal sT As String, strcor() As String)
    Dim N_N As Integer, II, Temp_K, Temp_A, Temp_B
    Dim re(1000) As String
    sT = sT & " "
    N_N = Len(sT)
    For II = 1 To N_N
        Temp_A = Mid$(sT, II, 1)
        If Temp_A = "," Then
            Temp_K = Temp_K + 1
            re(Temp_K) = Temp_B
            Temp_B = ""
        Else
            Temp_B = Temp_B + Temp_A
        End If
    Next
    If Temp_K > 0 Then
        re(Temp_K + 1) = Mid$(Temp_B, 1, Len(Temp_B) - 1)
        Temp_K = Temp_K + 1
    End If
    N_N = 0
    For II = 1 To Temp_K
        If Trim(re(II)) <> "" Then
            N_N = N_N + 1
            strcor(N_N) = re(II)
        End If
    Next
    SpaceGPSData = N_N
End Function