窗体(终结板).frm

一个动态GPS导航的软件

tl = xb(1) / xb(0)
If tl < 0 Then
bb(1) = Atn(tl) + 3.14159265358979
Else
bb(1) = Atn(tl)
End If

'计算H-----------------
Dim h1 As Double, h2 As Double, h3 As Double
n = c / Sqr(1 + e21 * Cos(bb(0)) * Cos(bb(0)))
h1 = Sqr(xb(0) * xb(0) + xb(1) * xb(1))
h2 = h1 / Cos(bb(0))
h3 = h2 - n

bb(2) = xb(2) / Sin(bb(0)) - n * (1 - e2)
'xyz-xy(bj54)
Dim l0 As Double, x0 As Double


b = bb(0)
x0 = 111134.861 * b * 180 / 3.14159265358979 - 16036.48 * Sin(b * 2) + 16.828 * Sin(4 * b) - 0.022 * Sin(6 * b)
'a = 6378245
'e2 = 0.006693421622966
'e21 = 0.006738525414683
a = 6378140
e2 = 0.006694385048819
e21 = 0.00673950186937
l0 = 117 * 3.14159265358979 / 180


Dim t As Double, sb As Double, cb As Double, et As Double, blh(3) As Double
blh(0) = bb(0)
blh(1) = bb(1)
blh(2) = bb(2)
Print blh(1), l0


w = Sqr(1 - e2 * Sin(blh(0)) * Sin(blh(0)))
n = a / w
t = Tan(blh(0))
sb = Sin(blh(0))
cb = Cos(blh(0))
et = e21 * Cos(blh(0)) * Cos(blh(0))
l = (blh(1) - l0) * 180 * 3600 / 3.14159265358979
p = 180 / 3.14159265358979
p = p * 3600
xg(0) = x0 + n * sb * cb * l * l / (2 * p * p) + n * sb * cb ^ 3 * (5 - t * t + 9 * et * et + 4 * et ^ 4) * l ^ 4 / (24 * p ^ 4) + n * sb * cb ^ 5 * (61 - 58 * t * t + t ^ 4) * l ^ 6 / (720 * p ^ 6)
xg(1) = n * cb * l / p + n * cb ^ 3 * (1 - t * t + et * et) * l ^ 3 / (6 * p ^ 3) + n * cb ^ 5 * (5 - 18 * t * t + t ^ 4 + 14 * et * et - 58 * et * et * t * t) * l ^ 5 / (120 * p ^ 5)

xg(1) = xg(1) + 20000000 + 500000

x80 = xg(0)
y80 = xg(1)
Call showxy(x80, y80)
End Function

'图片框操作
Public Sub kkk()
VScroll1.Left = Form1.ScaleWidth - VScroll1.Width
HScroll1.Top = Form1.ScaleHeight - HScroll1.Height
VScroll1.Height = Form1.ScaleHeight - 255
HScroll1.Width = Form1.ScaleWidth
HScroll1.ZOrder
VScroll1.ZOrder
HScroll1.Max = Picture2.Width - Form1.ScaleWidth
VScroll1.Max = Picture2.Height - Form1.ScaleHeight
End Sub
'窗口变化事件
Private Sub Form_Resize()
Call kkk
End Sub
'竖直滚动条变化
Private Sub VScroll1_Change()
Picture2.Top = -VScroll1.Value
End Sub
'水平滚动条变化
Private Sub HScroll1_Change()
Picture2.Left = -HScroll1.Value
End Sub
Private Sub 开始测量_Click()
开始测量.Enabled = False
结束测量.Enabled = True
MSComm1.CommPort = 1                 '...使用Com1口
MSComm1.Settings = "4800,n,8,1"      '...设置通讯参数
MSComm1.InputMode = comInputModeText '设置寄存器读取文件的格式为文本
MSComm1.InputLen = 150
MSComm1.RThreshold = 150
If MSComm1.PortOpen = False Then
   MSComm1.PortOpen = True              '...打开串口
End If

End Sub
Private Sub Mscomm1_Oncomm()        '...通讯事件发生
'MsgBox ("kaishiceliang")
Select Case MSComm1.CommEvent

Case comEvReceive            '...有接收事件发生
  anystring = MSComm1.Input  '...接收显示数据
  Open "d://55.txt" For Append As #21
  Print #21, anystring,
  Close #21
  Call stringjs2(anystring)

  MSComm1.InBufferCount = 0  '...清空输入寄存器

End Select

End Sub
'菜单相关程序
Private Sub 结束测量_Click()
MSComm1.PortOpen = False   '关闭串口
开始测量.Enabled = True
结束测量.Enabled = True
End Sub
Private Sub 退出程序_Click()
End
End Sub
Private Sub GGA_Click()
Call openfile
End Sub
Private Sub 二进制_Click()
MsgBox ("暂不提供此服务 ")
End Sub
'打开文件
Public Sub openfile()
Dim lstr As String, linethl As Integer, first5 As String, midline As String, length1 As Integer
Dim length2 As Integer, length3 As Integer, length4 As Integer, length5 As Integer
Dim intmidline As Double
Dim midline1 As String
midline1 = " "
 For i = 0 To 4
   lon1(i) = 0
 Next i
Open "d://GGA.txt" For Input As #1
Do While Not EOF(1)
   Line Input #1, lstr
   'Print Lstr
   lineth1 = Len(lstr)
   first5 = Mid(lstr, 2, 5)   '第一个字符是否都是$？？？
      If first5 = "GPGGA" Then
      length2 = 0
      For length1 = 6 To lineth1
        midline = Mid(lstr, length1, 1)
        'Print midline
        If midline = "," Then
           length2 = length2 + 1
           If length2 = "2" Or length2 = "4" Or length2 = "9" Or length2 = "11" Then
           length3 = length1
           Print length3
           End If
           If length2 = "3" Or length2 = "5" Or length2 = "10" Or length2 = "12" Then
           length4 = length1
           Print length4
           End If
           k = length4 - length3
           If length4 > length3 Then
           
           midline = Mid(lstr, length3 + 1, k - 1)
           intmidline = midline
           
           If length2 = 3 Then
             lon1(1) = intmidline
             lon1(1) = lon1(1) / 100
             'lon1(2) = 0
           End If
           
           If length2 = 5 Then
             lon1(2) = intmidline
             lon1(2) = lon1(2) / 100
           End If
           
           If length2 = 10 Then
             lon1(3) = intmidline
            ' lon1(2) = 0
           End If
           
           If length2 = 12 Then
             lon1(4) = intmidline
            ' lon1(2) = 0
           End If
           
           length4 = 0
           length3 = length4
           
           If (Not lon1(1) = "0") And (Not lon1(2) = "0") Then
           
           Open "d://22.txt" For Append As #20
           Print #20, lon1(1), lon1(2), lon1(3), lon1(4)
           Close #20
           
          Call blhtoBLH(lon1(1), lon1(2), lon1(3))
          Open "d://11.txt" For Append As #21
          Print #21, x80, y80
          
          Close #21
      
           End If
          lon1(2) = 0


           End If
        End If
      Next
      End If
Loop

Close #1

End Sub

Private Sub 卫星个数_Click()
MsgBox (lon2(4))
End Sub
Private Sub DOP值_Click()
MsgBox (lon1(3))
End Sub
Public Function stringjs2(kkk As String)
Dim stri1 As String, stri2 As String, stri3 As String, stri4 As String, stri5 As String, stri6 As String
Dim ii As Integer, jj As Integer
stri2 = kkk

For ii = 1 To 145
  
  stri1 = Mid(kkk, ii, 5)
  If stri1 = "GPGGA" Then
    kk = 0
    For jj = 1 To 70
     stri5 = Mid(kkk, (ii + jj), 1)
     stri6 = Mid(kkk, (ii + jj + 1), 1)
     
     If stri5 = "," Then
       kk = kk + 1
     End If
     
     If (kk = 14) And (stri6 = "*") Then
     stri3 = Mid(kkk, ii, jj + 4)
    
    Open "d://88.txt" For Append As #51
    Print #51, stri3
    Close #51
     
     Call stringtodoublekkk(stri3)
     
     End If
    Next jj
    End If
Next ii
End Function

'每一行进行异或检验
Public Function stringtodoublekkk(nnn As String)
Dim int11 As Integer, str11 As String, str22 As String, str33 As String
Dim int22 As Integer, int33 As Integer, int44 As Integer, int55 As Integer, int66 As Double, int77 As Integer, int88 As Integer
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer
str11 = nnn
int22 = Len(str11)
j = 0
k = 1

 int44 = Asc("G")
 For int33 = 2 To int22 - 3
   str22 = Mid(str11, int33, 1)
   int55 = Asc(str22)
   int44 = int44 Xor int55
 Next
 
 For i = 1 To int22
  str22 = Mid(str11, i, 1)
   If str22 = "," Then
    j = j + 1
   End If
   If (j = 14) And (k = 1) Then
    int66 = Mid(str11, i + 2, 1)
    k = 2
    str33 = Mid(str11, i + 3, 1)
   End If
   
 Next i


If str33 = "A" Then
int77 = int66 * 16 + 10
End If
If str33 = "B" Then
int77 = int66 * 16 + 11
End If
If str33 = "C" Then
int77 = int66 * 16 + 12
End If
If str33 = "D" Then
int77 = int66 * 16 + 13
End If
If str33 = "E" Then
int77 = int66 * 16 + 14
End If
If str33 = "F" Then
int77 = int66 * 16 + 15
End If
If (str33 >= "0") And (str33 <= "9") Then
int88 = str33
int77 = int66 * 16 + str33
End If
If int44 = int77 Then
Call stringtodouble(nnn)
Else:
End If

End Function