frmdocument.frm

GPS实时定位的程序实现,GPS实时定位的程序实现 希望对大家有帮助

      BorderWidth     =   2
      Index           =   2
      X1              =   114.642
      X2              =   130.592
      Y1              =   394.179
      Y2              =   394.179
   End
   Begin VB.Line norLine 
      BorderColor     =   &H00FFFFFF&
      BorderWidth     =   2
      Index           =   1
      X1              =   114.642
      X2              =   130.592
      Y1              =   402.162
      Y2              =   402.162
   End
   Begin VB.Line norLine 
      BorderColor     =   &H00FFFFFF&
      BorderWidth     =   2
      Index           =   0
      X1              =   114.642
      X2              =   130.592
      Y1              =   410.146
      Y2              =   410.146
   End
   Begin VB.Label Label1 
      BackColor       =   &H00000000&
      Caption         =   "Satellite Geometry"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   13.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   345
      Left            =   420
      TabIndex        =   17
      Top             =   2715
      Width           =   2910
   End
   Begin VB.Shape Shape4 
      BorderColor     =   &H00FFFFFF&
      BorderWidth     =   2
      Height          =   3735
      Left            =   150
      Shape           =   4  'Rounded Rectangle
      Top             =   2970
      Width           =   3375
   End
   Begin VB.Label Label3 
      BackColor       =   &H00000000&
      Caption         =   "Signal to Noise Ratio"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   13.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   360
      Left            =   240
      TabIndex        =   16
      Top             =   645
      Width           =   3345
   End
   Begin VB.Shape Shape1 
      BorderColor     =   &H00FFFFFF&
      BorderWidth     =   2
      Height          =   1935
      Left            =   105
      Shape           =   4  'Rounded Rectangle
      Top             =   840
      Width           =   3375
   End
   Begin VB.Shape Shape2 
      BorderColor     =   &H00808080&
      BorderWidth     =   3
      Height          =   1530
      Left            =   1080
      Shape           =   3  'Circle
      Top             =   4095
      Width           =   1530
   End
   Begin VB.Line Line1 
      BorderColor     =   &H000000C0&
      BorderStyle     =   3  'Dot
      X1              =   121.62
      X2              =   121.62
      Y1              =   221.538
      Y2              =   425.114
   End
   Begin VB.Line Line2 
      BorderColor     =   &H000000C0&
      BorderStyle     =   3  'Dot
      X1              =   21.931
      X2              =   224.299
      Y1              =   324.324
      Y2              =   324.324
   End
   Begin VB.Shape Shape3 
      BackColor       =   &H00000F01&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00808080&
      BorderWidth     =   3
      Height          =   3060
      Left            =   315
      Shape           =   3  'Circle
      Top             =   3345
      Width           =   3060
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackColor       =   &H00000000&
      Caption         =   "NORTH"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   10.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000C0&
      Height          =   270
      Index           =   0
      Left            =   1515
      TabIndex        =   18
      Top             =   3045
      Width           =   855
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackColor       =   &H00000000&
      Caption         =   "SOUTH"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   10.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000C0&
      Height          =   270
      Index           =   1
      Left            =   1515
      TabIndex        =   19
      Top             =   6420
      Width           =   840
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim sArray() As String  ' global array to hold NMEA sentences (strings)
Dim sCnt As Integer  ' integer to hold NMEA sentence count
Public pnt As MapObjects2.Point  ' recorded point (GPS)
Dim lineSeg As MapObjects2.Line  ' line to target
Dim targetPt As MapObjects2.Point  ' target point

Public demLayer As New MapObjects2.ImageLayer
Public OPLayer As MapObjects2.MapLayer
Public VSLayer As MapObjects2.MapLayer
Dim Movement As Boolean
'

Public Function NMEAtoScreenY(Elevation As Byte, Azimuth As Integer, ySize As Integer) As Integer
'This function converts elevation and azimuth to pixels (Y-coord)
'O.C. Ray Bivens, Dec 98

Const DegreestoRadians = 0.01744

Dim Length As Double
Dim ChangeSign As Integer
Dim Res1 As Integer
Dim Res2 As Double

Length = Abs(Elevation - 90) * Cos(Azimuth * DegreestoRadians)
ChangeSign = CInt(Length * -1)
Res1 = Abs(ChangeSign + 90)
Res2 = 180 / ySize
NMEAtoScreenY = CInt(Res1 / Res2)

End Function

Public Function NMEAtoScreenX(Elevation As Byte, Azimuth As Integer, xSize As Integer) As Integer
'This function converts elevation and azimuth to pixels (X-coord)
'O.C. Ray Bivens, Dec 98
Const DegreestoRadians = 0.01744

Dim Length As Double
Dim ChangeSign As Integer
Dim Res1 As Integer
Dim Res2 As Double

Length = Abs(Elevation - 90) * Sin(Azimuth * DegreestoRadians)
ChangeSign = CDbl(Length)
Res1 = Abs(ChangeSign + 90)
Res2 = 180 / xSize
NMEAtoScreenX = CInt(Res1 / Res2)

End Function

Function RotateX(Xpos As Integer, Ypos As Integer, RotDegrees As Single, xCenter As Integer, yCenter As Integer) As Integer
' This will rotate the given Xcoord

Dim yTemp As Integer
Dim xTemp As Integer
Dim RotCosin As Double
Dim RotSin As Double
Dim newX As Integer
Dim pi As Double
Dim rotation As Double

    pi = 4 * Atn(1)
    rotation = RotDegrees * pi / 180

    RotCosin = Cos(rotation)
    RotSin = Sin(rotation)
        yTemp = Ypos - yCenter
        xTemp = Xpos - xCenter
        newX = ((xTemp * RotCosin) - (yTemp * RotSin)) + xCenter

    RotateX = newX
    
End Function
Function RotateY(Xpos As Integer, Ypos As Integer, RotDegrees As Single, xCenter As Integer, yCenter As Integer) As Integer
' This will rotate the given Ycoord

Dim yTemp As Integer
Dim xTemp As Integer
Dim RotCosin As Double
Dim RotSin As Double
Dim newY As Integer
Dim pi As Double
Dim rotation As Double

    pi = 4 * Atn(1)
    rotation = RotDegrees * pi / 180
    RotCosin = Cos(rotation)
    RotSin = Sin(rotation)
        xTemp = Xpos - xCenter
        yTemp = Ypos - yCenter
        newY = ((yTemp * RotCosin) + (xTemp * RotSin) + yCenter)

    RotateY = newY
    
End Function

Sub RotateArrow(Degrees As Single)
'Rotates graphics on the screen (North arrow)

Dim n As Integer
Dim skip As Integer
skip = 409

For n = 0 To 14
    DoEvents
    norLine(n).X1 = RotateX(112, skip, Degrees, 120, 322)
    norLine(n).Y1 = RotateY(112, skip, Degrees, 120, 322)
    norLine(n).X2 = RotateX(128, skip, Degrees, 120, 322)
    norLine(n).Y2 = RotateY(128, skip, Degrees, 120, 322)
    skip = skip - 8
Next n

DoEvents
    With norLine(15)
        .X1 = RotateX(104, 289, Degrees, 120, 322)
        .Y1 = RotateY(104, 289, Degrees, 120, 322)
        .X2 = RotateX(136, 289, Degrees, 120, 322)
        .Y2 = RotateY(136, 289, Degrees, 120, 322)
    End With
    
    With norLine(16)
        .X1 = RotateX(104, 281, Degrees, 120, 322)
        .Y1 = RotateY(104, 281, Degrees, 120, 322)
        .X2 = RotateX(136, 281, Degrees, 120, 322)
        .Y2 = RotateY(136, 281, Degrees, 120, 322)
    End With

    With norLine(17)
        .X1 = RotateX(106, 273, Degrees, 120, 322)
        .Y1 = RotateY(106, 273, Degrees, 120, 322)
        .X2 = RotateX(134, 273, Degrees, 120, 322)
        .Y2 = RotateY(134, 273, Degrees, 120, 322)
    End With
    
    With norLine(18)
        .X1 = RotateX(108, 265, Degrees, 120, 322)
        .Y1 = RotateY(108, 265, Degrees, 120, 322)
        .X2 = RotateX(132, 265, Degrees, 120, 322)
        .Y2 = RotateY(132, 265, Degrees, 120, 322)
    End With
    
    With norLine(19)
        .X1 = RotateX(110, 257, Degrees, 120, 322)
        .Y1 = RotateY(110, 257, Degrees, 120, 322)
        .X2 = RotateX(130, 257, Degrees, 120, 322)
        .Y2 = RotateY(130, 257, Degrees, 120, 322)
    End With
    
    With norLine(20)
        .X1 = RotateX(112, 249, Degrees, 120, 322)
        .Y1 = RotateY(112, 249, Degrees, 120, 322)
        .X2 = RotateX(128, 249, Degrees, 120, 322)
        .Y2 = RotateY(128, 249, Degrees, 120, 322)
    End With
    
    With norLine(21)
        .X1 = RotateX(118, 241, Degrees, 120, 322)
        .Y1 = RotateY(118, 241, Degrees, 120, 322)
        .X2 = RotateX(122, 241, Degrees, 120, 322)
        .Y2 = RotateY(122, 241, Degrees, 120, 322)
    End With
    
    With norLine(22)
        .X1 = RotateX(119, 233, Degrees, 120, 322)
        .Y1 = RotateY(119, 233, Degrees, 120, 322)
        .X2 = RotateX(121, 233, Degrees, 120, 322)
        .Y2 = RotateY(121, 233, Degrees, 120, 322)
    End With

End Sub

Private Sub playNMEA(sArray As Variant)
'play the NMEA file or stream from GPS...

Dim gsv As GPGSV
Dim rmc As GPRMC
Dim gga As GPGGA
Dim gsa As GPGSA
Dim Utils As New CParseUtils
Dim Sentence As Integer
Dim pcsUTM As New MapObjects2.ProjCoordSys
Dim gcsGeo As New MapObjects2.GeoCoordSys
Dim hLine As MapObjects2.Line, vLine As MapObjects2.Line
Dim hPoints As MapObjects2.Points, vPoints As MapObjects2.Points
Dim hPntA As MapObjects2.Point, vPntA As MapObjects2.Point
Dim hPntB As MapObjects2.Point, vPntB As MapObjects2.Point
Dim ptbuffer As MapObjects2.Polygon
Dim pts As MapObjects2.Points
Dim oEvent As MapObjects2.GeoEvent
Dim iAzimuth As Integer
Dim n As Integer ' control var...
Dim VSRecs As MapObjects2.Recordset 'viewshed test

Dim i As Integer
For i = 0 To 7
    labSV(i).Visible = True
Next

On Error Resume Next
tlbMain.Buttons("target").Enabled = True

For Sentence = 0 To sCnt - 1
  If Movement = True Then
    If Utils.Parse(sArray(Sentence), 1) = "$GPGSV" Then
        Set gsv = New GPGSV
        With gsv
        .Sentence = sArray(Sentence)
            If .MessageNumber = 1 Then
                    DoEvents
                    Fill(0).Top = .SNR(0)
                    Fill(1).Top = .SNR(1)
                    Fill(2).Top = .SNR(2)
                    Fill(3).Top = .SNR(3)
                    labSNR(0) = .PRN(0)
                    labSNR(1) = .PRN(1)
                    labSNR(2) = .PRN(2)
                    labSNR(3) = .PRN(3)
                    labSV(0).Left = NMEAtoScreenX(.Elevation(0), .Azimuth(0), 202) + 15
                    labSV(0).Top = NMEAtoScreenY(.Elevation(0), .Azimuth(0), 204) + 212
                    labSV(0).Caption = Chr(32) & Chr(32) & .PRN(0) & vbCrLf & Chr(149) & " " & .Azimuth(0) & Chr(176) & vbCrLf & Chr(32) & Chr(32) & Chr(32) & .Elevation(0) & Chr(176)
                    labSV(1).Left = NMEAtoScreenX(.Elevation(1), .Azimuth(1), 202) + 15
                    labSV(1).Top = NMEAtoScreenY(.Elevation(1), .Azimuth(1), 204) + 212
                    labSV(1).Caption = Chr(32) & Chr(3