frmgps.frm

监听端口并解析所有的GPS数据. WINCE上可用.

VERSION 5.00
Object = "{481BA4A3-56F2-11D1-A1AB-00C04FA87A04}#1.0#0"; "MSCECOMM.DLL"
Begin VB.Form frmGPS 
   Caption         =   "Larry Roof's GPS Example"
   ClientHeight    =   2820
   ClientLeft      =   60
   ClientTop       =   630
   ClientWidth     =   6990
   LinkTopic       =   "Form1"
   ScaleHeight     =   2820
   ScaleWidth      =   6990
   WindowState     =   2  'Maximized
   Begin VB.TextBox txtLongitude 
      Alignment       =   1  'Right Justify
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   3960
      TabIndex        =   4
      Top             =   90
      Width           =   1215
   End
   Begin VB.TextBox txtLatitude 
      Alignment       =   1  'Right Justify
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   1200
      Locked          =   -1  'True
      TabIndex        =   2
      Top             =   90
      Width           =   1215
   End
   Begin CECOMMCtl.Comm ceComm 
      Left            =   480
      Top             =   2220
      CommPort        =   1
      Settings        =   "9600,N,8,1"
      InputLen        =   0
      InputMode       =   0   'False
      NullDiscard     =   0   'False
      ParityReplace   =   "?"
      Rthreshold      =   0
      SThreshold      =   0
      Handshaking     =   0
      DTREnable       =   0   'False
      RTSEnable       =   0   'False
   End
   Begin VB.TextBox txtReceive 
      Height          =   2235
      Left            =   60
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   540
      Width           =   6855
   End
   Begin VB.Label lblStatus 
      Alignment       =   2  'Center
      BackColor       =   &H00000000&
      Caption         =   "Not Gathering"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   5340
      TabIndex        =   5
      Top             =   120
      Width           =   1575
   End
   Begin VB.Label Label2 
      Caption         =   "Longitude:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   2640
      TabIndex        =   3
      Top             =   120
      Width           =   1155
   End
   Begin VB.Label Label1 
      Caption         =   "Latitude:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   975
   End
   Begin VB.Menu mnuFunctions 
      Caption         =   "&Functions"
      Begin VB.Menu mnuFunctionsGather 
         Caption         =   "&Gather data"
      End
      Begin VB.Menu mnuFunctionsCopy 
         Caption         =   "&Copy data to Clipboard"
      End
   End
   Begin VB.Menu mnuConfiguration 
      Caption         =   "&Configuration"
      Begin VB.Menu mnuConfigureAmount 
         Caption         =   "&Set amount of data to gather"
      End
   End
End
Attribute VB_Name = "frmGPS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim iAmountOfData
Sub DetermineLocation()
' This routine parses the data that has been received to determine the current
' latitude and longitude.

  Dim iEndLocation
  Dim iStartLocation

' Locate the first record type that contains location data.
  iStartLocation = InStr(1, txtReceive.Text, "$GPGLL", vbTextCompare)

' If the first record type is not present try another record type.
  If (iStartLocation = 0) Then
    iStartLocation = InStr(1, txtReceive.Text, "$GPRMC", vbTextCompare)
    
' If neither record type is available then clear out the display and exit.
    If (iStartLocation = 0) Then
      txtLatitude.Text = "---"
      txtLongitude.Text = "---"
      Exit Sub
    End If
    
' Add the offset for the location data.
    iStartLocation = iStartLocation + 16
    
' Set offset for the location data for first record type.
  Else
    iStartLocation = iStartLocation + 7
  End If
  
' Extract the latitude.
  iEndLocation = InStr(iStartLocation, txtReceive.Text, ",", vbTextCompare)
  If (iEndLocation = 0) Then
    txtLatitude.Text = "---"
    txtLongitude.Text = "---"
    Exit Sub
  End If
  txtLatitude.Text = Mid(txtReceive.Text, iStartLocation, iEndLocation - iStartLocation)

' Extract the longitude.
  iStartLocation = iEndLocation + 3
  iEndLocation = InStr(iStartLocation, txtReceive.Text, ",", vbTextCompare)
  If (iEndLocation = 0) Then
    txtLongitude.Text = "---"
    Exit Sub
  End If
  txtLongitude.Text = Mid(txtReceive.Text, iStartLocation, iEndLocation - iStartLocation)

End Sub

Sub OpenPort()

  On Error Resume Next
  
' Configure the settings of 4800 bps, no parity, 8 data bits, and 1 stop bit.
  ceComm.Settings = "4800,n,8,1"
  If Err.Number <> 0 Then
    MsgBox "Error setting properties." & vbCrLf & Err.Number & " - " & Err.Description
    Err.Clear
    Exit Sub
  End If

' Configure it to use Comm port 1.
  ceComm.CommPort = 1
  If Err.Number <> 0 Then
    MsgBox "Error setting Comm port number." & vbCrLf & Err.Number & " - " & Err.Description
    Err.Clear
    Exit Sub
  End If
    
' Open the Comm port.
  ceComm.PortOpen = True
  If Err.Number <> 0 Then
    MsgBox "Error opening the Comm port." & vbCrLf & Err.Number & " - " & Err.Description
    Err.Clear
    Exit Sub
  End If
  
' Let the user know that data is being received.
  lblStatus.Caption = "Gathering"
  
End Sub

Private Sub ceComm_OnComm()
  Select Case ceComm.CommEvent
    Case 2 ' Data received.
      txtReceive.Text = txtReceive.Text & ceComm.Input
      If (Len(txtReceive.Text) >= iAmountOfData) Then
        ceComm.PortOpen = False
        lblStatus.Caption = "Not Gathering"
        DetermineLocation
      End If
  End Select
End Sub





Private Sub Form_Load()

' Fit the interface to the palmtop.
  AdjustControls

' Set the threshold property which in turn enables the receive event.
' You could just as well set this property from code but I wanted to make sure
' that you saw them being configured.
  ceComm.Rthreshold = 20
  
' Set default size of amount of data to gather.
  iAmountOfData = 1000

End Sub
Sub AdjustControls()
' Extend the size of the interface to match the size of the display on the palmtop.
  txtReceive.Width = frmGPS.Width - txtReceive.Left - 150
  lblStatus.Left = frmGPS.Width - lblStatus.Width - 150
End Sub

Private Sub mnuConfigureAmount_Click()
  Dim sTempAmount
  
' Prompt the user for the amount of data that should be gathered.
  sTempAmount = InputBox("Enter the amount of data to gather: ", "Configuring Data Size", iAmountOfData)
  If (sTempAmount <> "") And (IsNumeric(sTempAmount)) Then
    iAmountOfData = Val(sTempAmount)
  End If
  
End Sub

Private Sub mnuFunctionsCopy_Click()

' Copy all of the data that has been received to the Clipboard.
  Clipboard.SetText txtReceive.Text
  
End Sub


Private Sub mnuFunctionsGather_Click()

' Clear out the display.
  txtReceive.Text = ""
  txtLatitude.Text = ""
  txtLongitude.Text = ""

' Open the Comm port which in turn enables data gathering to occur.
  OpenPort

End Sub