窗体(终结板).frm

一个动态GPS导航的软件

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   Caption         =   "Form1"
   ClientHeight    =   6585
   ClientLeft      =   165
   ClientTop       =   855
   ClientWidth     =   10560
   LinkTopic       =   "Form1"
   ScaleHeight     =   6585
   ScaleWidth      =   10560
   StartUpPosition =   3  'Windows Default
   Begin MSCommLib.MSComm MSComm1 
      Left            =   9600
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.HScrollBar HScroll1 
      Height          =   255
      LargeChange     =   1000
      Left            =   0
      TabIndex        =   0
      Top             =   6360
      Width           =   10575
   End
   Begin VB.VScrollBar VScroll1 
      Height          =   6375
      LargeChange     =   3000
      Left            =   10320
      TabIndex        =   1
      Top             =   0
      Width           =   255
   End
   Begin VB.PictureBox Picture2 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   18060
      Left            =   0
      Picture         =   "窗体(终结板).frx":0000
      ScaleHeight     =   18000
      ScaleWidth      =   15000
      TabIndex        =   3
      Top             =   0
      Width           =   15060
   End
   Begin VB.PictureBox Picture1 
      Height          =   6375
      Left            =   0
      ScaleHeight     =   6315
      ScaleWidth      =   10155
      TabIndex        =   2
      Top             =   0
      Width           =   10215
   End
   Begin VB.Menu 测量 
      Caption         =   "测量"
      Begin VB.Menu 开始测量 
         Caption         =   "开始测量"
      End
      Begin VB.Menu 结束测量 
         Caption         =   "结束测量"
      End
      Begin VB.Menu 退出程序 
         Caption         =   "退出程序"
      End
   End
   Begin VB.Menu 文件 
      Caption         =   "文件"
      Begin VB.Menu 打开文件 
         Caption         =   "打开文件"
         Begin VB.Menu GGA 
            Caption         =   "GGA"
         End
         Begin VB.Menu 二进制 
            Caption         =   "二进制"
         End
      End
   End
   Begin VB.Menu 卫星状况 
      Caption         =   "卫星状况"
      Begin VB.Menu 卫星个数 
         Caption         =   "卫星个数"
      End
      Begin VB.Menu DOP值 
         Caption         =   "DOP值"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim lon1(5) As Double
Dim x As Double, y As Double, z As Double
Dim lon2(8) As Double
Dim x80 As Double, y80 As Double
Dim dop As Double, weixing As Double
Dim anystring As String, strline() As String
Dim strstr3 As String, strstr2 As String, strstr4 As String
Dim strlink1 As String, strlink2 As String, strlink3 As String, strnum As Integer, strnum1 As Integer, strnum2 As Integer

Private Sub Form_Load()
HScroll1.Max = Picture2.Width - Picture1.Width
VScroll1.Max = Picture2.Height - Picture1.Height
End Sub
'提取接收机字符串数据中的坐标信息
Private Sub stringtodouble(lstr As String)
Dim intmidline As Double
Dim midline As String, m As String, midline1 As String
Dim lineth As Integer
Dim lon2(8) As Double
Dim dou11 As Double, dou22 As Double
Dim str1 As String, int1 As Integer, j As Integer

    Open "d://77.txt" For Append As #5
    Print #5, lstr
    Close #5

lineth = Len(lstr)
    For i = 1 To lineth
         first5 = Mid(lstr, i, 5)   '第一个字符是否都是$？？？
        If first5 = "GPGGA" Then
          j = 1
          For length1 = i + 4 To lineth
          midline = Mid(lstr, length1, 1)
         
          If midline = "," Then
           length2 = length2 + 1
           If length2 = "2" Or length2 = "4" Or length2 = "7" Or length2 = "9" Or length2 = "11" Then
           length3 = length1
           End If
           
           If length2 = "3" Or length2 = "5" Or length2 = "8" Or length2 = "10" Or length2 = "12" Then
           length4 = length1
           End If
           
           k = length4 - length3
           If length4 > length3 Then
            midline1 = Mid(lstr, length3 + 1, k - 1)

            If length2 = 3 And (k > 2) Then
              dou11 = midline1
            End If
            
            If (length2 = 5) And (k > 2) Then
              dou22 = midline1
            End If
           

             If length2 = 8 Then
              If midline1 = "" Then
               lon2(3) = 0
               lon2(4) = 0
              Else:
                str1 = Mid(lstr, length4 - 4, 1)
                int1 = str1
                lon2(3) = int1
                lon2(4) = midline1
              End If
             End If
            
            
            If length2 = 10 Then
              If midline1 = "" Then
               lon2(5) = 0
              Else:
               lon2(5) = midline1
              End If
            End If
           
            If length2 = 12 Then
              If midline1 = "" Then
              lon2(6) = 0
              Else:
               lon2(6) = midline1
              End If
               j = 2
            End If
           
            length4 = 0
            length3 = length4
            
            If j = 2 Then
            Open "d://66.txt" For Append As #33
            Print #33, dou11, dou22, lon2(3), lon2(4), lon2(5), lon2(6)
            dop = lon2(3)
            weixing = lon2(5)
            
            Close #33
          
            dou11 = dou11 / 100#
            dou22 = dou22 / 100#
            
            Call blhtoBLH(dou11, dou22, lon2(5))
            j = 1
            End If
            End If
           End If
        
       Next length1
      End If
   Next i
End Sub


'在picture2上画图
 Public Sub showxy(x As Double, y As Double)
 Dim x0 As Double, y0 As Double, xs As Double, ys As Double
 Picture2.Scale (0, 0)-(1000, 1200)
 x0 = 3390000#
 y0 = 20244000#
 xs = (y - y0) / 10#
 ys = (x0 - x) / 10#
   
  Picture2.DrawWidth = 2
  Picture2.DrawMode = 15
  Picture2.Line (xs - 8, ys)-(xs + 8, ys), vbRed
  Picture2.Line (xs, ys - 8)-(xs, ys + 8), vbRed
  
 End Sub
'角度化弧度 （度，分，秒）
Private Function www(b)

Dim b1 As Integer, b2 As Double
b1 = Int(b)
b2 = (b - b1) * 100
b = b1 + b2 / 60
b = b * 3.14159265358979 / 180
www = b

End Function
'弧度化角度
Private Function mmm(c)
c = c * 180 / 3.14159265358979
c1 = Int(c)
c2 = (c - c1) * 60
c3 = (c2 - Int(c2)) * 60
c = c1 + Int(c2) / 100 + c3 / 10000
mmm = c
End Function
'WGS-84到西安80坐标系
Public Function blhtoBLH(jingdu As Double, weidu As Double, gao As Double)
Dim x As Double, y As Double, z As Double
Dim a As Double, e2 As Double
Dim z1(8) As Double
Dim e21 As Double, c As Double
Dim b As Double, l As Double, h As Double, w As Double, n As Double
Dim xw(3) As Double, xb(3) As Double, bb(3) As Double, xg(2) As Double
'WGS84下的BLH到XYZ的转换
x = www(jingdu)
y = www(weidu)
z = gao

a = 6378137
e2 = 0.0066943799013

b = x
l = y
h = z

w = Sqr(1 - e2 * Sin(b) * Sin(b))
n = a / w
xw(0) = (n + h) * Cos(b) * Cos(l)
xw(1) = (n + h) * Cos(b) * Sin(l)
xw(2) = (n * (1 - e2) + h) * Sin(b)


'xyz(wgs84)-xyz(bj4)

For n = 0 To 7
z1(n) = 0
Next n



xb(0) = (1 + z1(6)) * (xw(0) + z1(2) * xw(1) - z1(1) * xw(2)) + z1(3)
xb(1) = (1 + z1(6)) * ((-1) * z1(2) * xw(0) + xw(1) + z1(0) * xw(2)) + z1(4)
xb(2) = (1 + z1(6)) * (z1(1) * xw(0) - z1(0) * xw(1) + xw(2)) + z1(5)

'xyz(bj4)-blh(bj54)

'e2 = 0.006693421622966
'e21 = 0.006738525414683
'c = 6399698.90178271
'a = 6378140
e2 = 0.006694385048819
e21 = 0.00673950186937
c = a * Sqr(1 + e21)

Dim t0 As Double, t1 As Double, t2 As Double, t3 As Double
Dim p As Double, k As Double
t0 = xb(2) / Sqr(xb(0) * xb(0) + xb(1) * xb(1))
t1 = t0
t3 = t0
p = c * e2 / Sqr(xb(0) * xb(0) + xb(1) * xb(1))
k = 1 + e21
t2 = 0
While Abs(t2 - t3) > 0.0000000000001
  t3 = t1
  t2 = t0 + p * t1 / Sqr(k + t1 * t1)
  t1 = t2
Wend
bb(0) = Atn(t2)

'计算L---------------
Dim tl As Double