⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 gpsboyce.ebf

📁 用VB+MapX实现的用于PDA和PC机的GPS显示源码(很有参考价值)
💻 EBF
📖 第 1 页 / 共 3 页
字号:
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   12582912
      Alignment       =   1
      UseMnemonic     =   -1  'True
      WordWrap        =   0   'False
   End
   Begin VBCE.Label lblAlt 
      Height          =   255
      Left            =   1800
      TabIndex        =   10
      Top             =   1320
      Width           =   1455
      _cx             =   2566
      _cy             =   450
      AutoSize        =   0   'False
      BackColor       =   -2147483643
      BackStyle       =   1
      BorderStyle     =   0
      Caption         =   "00000.00 feet alt"
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   -2147483640
      Alignment       =   0
      UseMnemonic     =   -1  'True
      WordWrap        =   0   'False
   End
   Begin VBCE.Label Label2 
      Height          =   255
      Left            =   1440
      TabIndex        =   9
      Top             =   3120
      Width           =   735
      _cx             =   1296
      _cy             =   450
      AutoSize        =   0   'False
      BackColor       =   -2147483643
      BackStyle       =   1
      BorderStyle     =   0
      Caption         =   "Bearing"
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   -2147483640
      Alignment       =   0
      UseMnemonic     =   -1  'True
      WordWrap        =   0   'False
   End
   Begin VBCE.Label Label1 
      Height          =   255
      Left            =   120
      TabIndex        =   8
      Top             =   3120
      Width           =   975
      _cx             =   1720
      _cy             =   450
      AutoSize        =   0   'False
      BackColor       =   -2147483643
      BackStyle       =   1
      BorderStyle     =   0
      Caption         =   "Satellites"
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   -2147483640
      Alignment       =   0
      UseMnemonic     =   -1  'True
      WordWrap        =   0   'False
   End
   Begin VBCE.Label lblStatus 
      Height          =   255
      Left            =   1680
      TabIndex        =   7
      Top             =   240
      Width           =   1815
      _cx             =   3201
      _cy             =   450
      AutoSize        =   0   'False
      BackColor       =   -2147483643
      BackStyle       =   1
      BorderStyle     =   0
      Caption         =   "Status"
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   255
      Alignment       =   1
      UseMnemonic     =   -1  'True
      WordWrap        =   0   'False
   End
   Begin VBCE.Label lblSpeed 
      Height          =   255
      Left            =   1800
      TabIndex        =   6
      Top             =   1080
      Width           =   1215
      _cx             =   2143
      _cy             =   450
      AutoSize        =   0   'False
      BackColor       =   -2147483643
      BackStyle       =   1
      BorderStyle     =   0
      Caption         =   "000.00 MPH"
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   -2147483640
      Alignment       =   0
      UseMnemonic     =   -1  'True
      WordWrap        =   0   'False
   End
   Begin VBCE.Label lblLong 
      Height          =   255
      Left            =   1800
      TabIndex        =   5
      Top             =   840
      Width           =   1575
      _cx             =   2778
      _cy             =   450
      AutoSize        =   0   'False
      BackColor       =   -2147483643
      BackStyle       =   1
      BorderStyle     =   0
      Caption         =   "74.000000 W"
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   -2147483640
      Alignment       =   0
      UseMnemonic     =   -1  'True
      WordWrap        =   0   'False
   End
   Begin VBCE.Label lblLat 
      Height          =   255
      Left            =   1800
      TabIndex        =   4
      Top             =   600
      Width           =   1575
      _cx             =   2778
      _cy             =   450
      AutoSize        =   0   'False
      BackColor       =   -2147483643
      BackStyle       =   1
      BorderStyle     =   0
      Caption         =   "40.000000 N"
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   -2147483640
      Alignment       =   0
      UseMnemonic     =   -1  'True
      WordWrap        =   0   'False
   End
   Begin VBCE.CommandButton btnGo 
      Height          =   375
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   615
      _cx             =   1085
      _cy             =   661
      BackColor       =   12632256
      Caption         =   "Go"
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Style           =   0
   End
   Begin VBCE.Timer Timer1 
      Left            =   3120
      Top             =   2160
      _cx             =   847
      _cy             =   847
      Enabled         =   -1  'True
      Interval        =   100
   End
End
Attribute VB_Name = "frmGPSBoyCE"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Declare Function BitBlt Lib "coredll" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Declare Function GetDC Lib "coredll" (ByVal hWnd As Long) As Long
Public Declare Function GetFocus Lib "coredll" () As Long
Public Declare Function GetWindow Lib "coredll" (ByVal hWnd As Long, ByVal wCmd As Long) As Long

Dim vbCrlf, vbCr

Dim Alt() As Integer
Dim CurAlt As Integer

Dim flag
Dim strUnparsed As String
Dim strCurrent As String

Dim satref(16) As Integer
Dim satclr(16) As Long
Dim totsats As Integer

Private Sub btnOptions_Click()
frmOptions.Show

End Sub

Private Sub Form_OKClick()
    App.End
End Sub


Private Sub btnGo_Click()
maxspd = 0
maxalt = 0

If Emulate = True Then
CmnDlg.DialogTitle = "Open a saved GPS log"
CmnDlg.FileName = "gpsout.txt"
CmnDlg.ShowOpen
FOut.Open CmnDlg.FileName, fsModeBinary, fsAccessRead
'   Set FOut = fs.OpenTextFile(CmnDlg.FileName, 1) ' open for reading
End If

If Emulate = False Then

'CmnDlg.DialogTitle = "Output a GPS log"
'CmnDlg.FileName = "gpsout.txt"

'CmnDlg.ShowOpen
'   Set FOut = fs.CreateTextFile(CmnDlg.FileName, 2) ' open for writing

    If MSComm1.PortOpen = False Then

    MSComm1.CommPort = 2
    MSComm1.Settings = "4800,N,8,1"
    MSComm1.PortOpen = True

    'Turn off GPRMC msgs
    'MSComm1.Output = "$PRWIILOG,RMC,V,,," & vbCrLf
    'Turn on GPRMC msgs
    'MSComm1.Output = "$PRWIILOG,RMC,A,,," & vbCrLf
  
    ' Turn on GPMRC msgs every 2 seconds
    MSComm1.Output = "$PRWIILOG,RMC,A,T,2,0" & vbCrlf
    ' Turn on GPGGA msgs every 2 seconds
    MSComm1.Output = "$PRWIILOG,GGA,A,T,2,0" & vbCrlf
    ' Turn off PRWIZCH messages
    MSComm1.Output = "$PRWIILOG,ZCH,V,,," & vbCrlf
End If
End If

flag = 1
' txtDisplay.Text = ""
End Sub

Private Sub btnMap_Click()
    curURL = "http://tiger.census.gov/cgi-bin/mapgen?&mlat=" & curlat & "&mlon=" & curlng & "&msym=bigdot&lat=" & curlat & "&lon=" & curlng & "&wid=1.000&ht=1.000"
    frmMap.Show
    frmMap.Caption = "Show map (" & curlat & "," & curlng & ")"
    frmMap.wbMap.Navigate curURL
End Sub

Private Sub btnStop_Click()
flag = 0
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
' And close the file!
FOut.Close

End Sub

Private Sub Form_Load()
flag = 0
Emulate = False

lblStatus.ForeColor = &HFF0000
lblStatus.Caption = "AWAITING FIX"

curlat = 41.1
curlng = -72.25
vbCrlf = Chr(13) & Chr(10)
vbCr = Chr(13)
'   Set fs = CreateObject("Scripting.FileSystemObject")
PlotLines picCompass
PlotLines picBearings

totsats = 0
InitSatColor

ReDim Alt(picAlt.ScaleWidth)
CurAlt = 0

End Sub

Private Sub form_unload(Cancel As Integer)
On Error Resume Next
   FOut.Close
End Sub

Private Sub MenuBar1_ButtonClick(ByVal Button As MenuBarLib.MenuBarButton)

End Sub

Private Sub PictureBox1_Click()

End Sub

Private Sub Timer1_Timer()
On Error Resume Next
Dim b

If flag = 1 Then
    If Emulate = True Then
        b = FOut.Input(1000)
        If Err = 62 Then ' past eof
        FOut.Close
        flag = 0
        End If
    Else
        b = MSComm1.Input
    End If
    strUnparsed = strUnparsed & b
    
    ParseInput
End If

End Sub
Sub ParseInput()
Dim crpos

If Len(strUnparsed) = 0 Then Exit Sub

crpos = InStr(1, strUnparsed, vbCr)

Do While crpos > 0
   strCurrent = Mid(strUnparsed, 1, crpos - 1)
   strUnparsed = Mid(strUnparsed, crpos + 2)
   crpos = InStr(1, strUnparsed, vbCr)
   
   If Emulate = False Then
   'Make unit start sending raw NMEA data
   If InStr(1, strCurrent, "ASTRAL") > 0 Then
       MSComm1.Output = "ASTRAL" & vbCr
       ' Turn on GPMRC msgs every 2 seconds
       MSComm1.Output = "$PRWIILOG,RMC,A,T,2,0" & vbCrlf
       ' Turn on GPMRC msgs every 2 seconds
       MSComm1.Output = "$PRWIILOG,GSA,A,T,5,0" & vbCrlf
       ' Turn on GPMRC msgs every 2 seconds
       MSComm1.Output = "$PRWIILOG,GSV,A,T,6,0" & vbCrlf
       ' Turn on GPGGA msgs every 2 seconds
       MSComm1.Output = "$PRWIILOG,GGA,A,T,4,0" & vbCrlf
       ' Turn off PRWIZCH messages
       MSComm1.Output = "$PRWIILOG,ZCH,V,,," & vbCrlf
       ' Preset lat/long/time
       
       If InitPos Then
       strPos = curlat & ",N," & Abs(curlng) & ",W,"
       Else
       strPos = ",,,,"
       End If
       
       If InitDate Then
           CurTime = Now  ' Adjust for UTC/GMT
           ' Time
           strDate = ""
           strDate = strDate & Mid("00" & Minute(CurTime), Len("00" & Minute(CurTime)) - 2, 2)
           strDate = strDate & Mid("00" & Hour(CurTime), Len("00" & Hour(CurTime)) - 2, 2)
           strDate = strDate & Mid("00" & Second(CurTime), Len("00" & Second(CurTime)) - 2, 2)
           
           strDate = strDate & ","
           ' Date
           strDate = strDate & Mid("00" & Day(CurTime), Len("00" & Day(CurTime)) - 2, 2)
           strDate = strDate & Mid("00" & Month(CurTime), Len("00" & Month(CurTime)) - 2, 2)
           strDate = strDate & Mid("00" & Year(CurTime), Len("00" & Year(CurTime)) - 2, 2)

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -