gps.txt

vb gps源码大全 vb程序 收录部分源程序

Private Sub GPSComm_OnComm() 
    On Error GoTo ErrHdl 

    Dim oData As String 
    Dim aData() As String 
    Dim aDataLen As Integer 
    Dim counter1 As Integer 
     
    oData = CStr(GPSComm.Input) 
     
    If Mid(oData, 1, 1) <> "$" Then 
        Exit Sub 
    End If 
     
    aData = Split(oData, vbCrLf) 
    aDataLen = 8 
     
    For counter1 = 1 To aDataLen Step 1 
      If Len(aData(counter1)) < 6 Then 
        Exit For 
      End If 
      If Mid(aData(counter1), 2, 5) = "GPRMC" Then 
        Dim gprmc() As String 
        Dim utime As Date 
        Dim status As Boolean 
        Dim Latitude As Double 
        Dim Longitude As Double 
        Dim Speed As Double 
        Dim Delta As Double 
         
        gprmc = Split(aData(counter1), ",") 
         
        Dim hour As String 
        Dim minute As String 
        Dim second As String 
         
        hour = Mid(gprmc(1), 1, 2) 
        minute = Mid(gprmc(1), 3, 2) 
        second = Mid(gprmc(1), 5, 2) 

        utime = Timevalue(hour & ":" & minute & ":" & second) 
         
        If gprmc(2) = "A" Then 
            status = True 
        Else 
            status = False 
            Exit Sub 
        End If 
         
        Latitude = CDbl(gprmc(3)) / 100 
        Longitude = CDbl(gprmc(5)) / 100 
                                         
'        '>分到度 
'        Dim PartA As String, PartB As String, DotPos As Integer, DblA As Double, DblB As Double 
'        'Dim NewLon As Double, NewLat As Double 
'        PartA = CStr(Longitude) 
'        DotPos = InStr(PartA, ".") 
' 
'        PartB = Mid(PartA, DotPos + 1, Len(PartA) - DotPos) 
'        PartA = Mid(PartA, 1, DotPos - 1) 
' 
'        DblA = CDbl(PartA) 
'        DblB = CDbl(Mid(PartB, 1, 2) & "." & Mid(PartB, 3, Len(PartB) - 2) & "0") / 60 
' 
'        Longitude = DblA + DblB 
' 
'        PartA = CStr(Latitude) 
'        DotPos = InStr(PartA, ".") 
'        PartB = Mid(PartA, DotPos + 1, Len(PartA) - DotPos) 
'        PartA = Mid(PartA, 1, DotPos - 1) 
'        DblA = CDbl(PartA) 
'        DblB = CDbl(Mid(PartB, 1, 2) & "." & Mid(PartB, 3, Len(PartB) - 2) & "0") / 60 
' 
'        Latitude = DblA + DblB 
'        '<分到度 
' 
         
        Speed = CDbl(gprmc(7)) * 1.609 
        Delta = CDbl(gprmc(8)) 
         
        Exit For 
      End If 
    Next
我的毕业设计是从GPS接收机接收数据（串口），用了VB的MSCOM控件。要接收的数据如下@××mdyyhmsffffaaaaoooohhhhmmmmaaaaoooohhhhmmmm
VVvvhhddntimsiddssrrccooooTTushmvvvvvvC<CR><LF> 不同的帧有不同的“××”，我要接收的是Ha，而且只需接收mdyyhmsffffaaaaoooohhhh这23个字符。 接收到数据后再存储到数据库中，数据库我用了一个DATA控件，我试了一下，没有问题，主要是数据接收方面。还有2个星期就要到实验室调试了，大家帮帮忙。 


第一次用VB，大家帮忙看看，但看的时候不要笑，看完才准笑。 （数据库的连接已连接好） 


Private Sub Command1_Click()
With MSComm
.InputMode = comInputModeBinary '设置数据接收模式为二进制形式
.InBufferCount = 0 '清除接收缓冲区
.PortOpen = True '打开串行口
.InputLen = 1
End With
End Sub 


Private Sub Command2_Click()
MSComm.PortOpen = False ' 关闭串行口
End
End Sub 


Private Sub Data_Text_Change() 


End Sub 


Private Sub Height_Text_Change() 


End Sub 


Private Sub MSComm_OnComm()
Dim buffer() As String
Dim d As Single
Dim q As Single
Dim a As Integer
Dim p As Integer
Dim c As Byte
Dim av() As Variant
Dim b As Integer
Select Case MSComm.CommEvent
' Handle each event or error by placing
' code below each case statement 


' 错误
Case comEventBreak ' 收到 Break。
Case comEventCDTO ' CD (RLSD) 超时。
Case comEventCTSTO ' CTS Timeout。
Case comEventDSRTO ' DSR Timeout。
Case comEventFrame ' Framing Error
Case comEventOverrun '数据丢失。
Case comEventRxOver '接收缓冲区溢出。
Case comEventRxParity ' Parity 错误。
Case comEventTxFull '传输缓冲区已满。
Case comEventDCB '获取 DCB] 时意外错误 


' 事件
Case comEvCD ' CD 线状态变化。
Case comEvCTS ' CTS 线状态变化。
Case comEvDSR ' DSR 线状态变化。
Case comEvRing ' Ring Indicator 变化。
Case comEvReceive ' 收到 RThreshold # of chars.
'============================================================
b = 0
Do Until b = 1 'b=1表示找到帧的开头
c = MSComm.Input
If c = "@" Then
c = MSComm.Input
If c = "@" Then
c = MSComm.Input
If c = "H" Then
c = MSComm.Input
If c = "a" Then
b = 1
End If
End If
End If
End If
Loop
MSComm1.InputLen = 23
Do Until MSComm.InBufferCount < 23
DoEvents
Loop
Text1.Text = MSComm.Input '接收需要的数据
'提取GPS信息到数组buffer()
buffer(0) = Mid(Text1, 1, 1)
buffer(1) = Mid(Text1, 2, 1)
buffer(2) = Mid(Text1, 3, 2)
buffer(3) = Mid(Text1, 5, 1)
buffer(4) = Mid(Text1, 6, 1)
buffer(5) = Mid(Text1, 7, 1)
buffer(6) = Mid(Text1, 8, 4)
buffer(7) = Mid(Text1, 12, 4)
buffer(8) = Mid(Text1, 16, 4)
buffer(9) = Mid(Text1, 20, 4)
'把字符串转换为相应的数字
av(0) = CInt(buffer(0))
av(1) = CInt(buffer(1))
av(2) = CInt(buffer(2))
av(3) = CInt(buffer(3))
av(4) = CInt(buffer(4))
av(5) = CInt(buffer(5))
av(6) = CLng(buffer(6))
av(7) = CLng(buffer(7))
d = (av(7) / 324000000) * 90
a = av(7) * 90 324000000
d = (d - a) * 360
av(8) = CLng(buffer(8))
q = (av(8) / 648000000) * 180
p = av(8) * 180 324000000
q = (q - p) * 360
av(9) = CLng(buffer(9))
'把数据存储到数据库
Data1.Recordset.AddNew
Data_Text.Text = av(2) & "年" & av(0) & "月" & av(1) & "日" '日期
Time_Text.Text = av(3) & ":" & av(4) & ":" & av(5) & ":" & av(6) '时间
If a < 0 Then
Latitude_Text.Text = "南纬" & a & "°" & d & "'" '纬度
Else: Latitude_Text.Text = "北纬" & a & "°" & d & "'"
If p < 0 Then
Longitude_Text.Text = "东经" & p & "°" & q & "'" '经度
Else: Longitude_Text.Text = "西经" & p & "°" & q & "'"
Height_Text.Text = av(9) & "米" '高度
Data1.Refresh
'============================================================
Case Else
End Select
End Sub