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

📄 form1.vb

📁 本源码是用VB开发的GPS追踪定位系统。
💻 VB
字号:
Public Class Form1
    '---serial port to connect to the GPS receiver---
    Private WithEvents serialPort As New IO.Ports.SerialPort

    '---IP address of the server---
    Private ServerIP As String = "10.0.1.4"

    '---the ID of the user---
    Private ID As String = "1"

    '---use for synchronization---
    Dim sync As New Sync

    '---Connect GPS---
    Private Sub MenuItem1_Click( _
       ByVal sender As System.Object, _
       ByVal e As System.EventArgs) _
       Handles MenuItem1.Click

        '---close the port if it is already open---
        If serialPort.IsOpen Then
            serialPort.Close()
        End If

        '---set the parameters and open the port---
        Try
            With serialPort
                .PortName = "COM4"
                .BaudRate = 9600
                .Parity = IO.Ports.Parity.None
                .DataBits = 8
                .StopBits = IO.Ports.StopBits.One
            End With
            serialPort.Open()
            '---disable the Connect GPS menu item---
            MenuItem1.Enabled = False
            '---enable the Disconnect menu item---
            MenuItem3.Enabled = True
        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try
    End Sub

    Private Sub DataReceived( _
           ByVal sender As Object, _
           ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) _
           Handles serialPort.DataReceived
        TextBox1.BeginInvoke(New _
           myDelegate(AddressOf updateTextBox), _
           New Object() {})
    End Sub

    Public Delegate Sub myDelegate()
    Public Sub updateTextBox()
        TextBox1.Text += serialPort.ReadExisting()
        'TextBox1.Text += serialPort.ReadLine & vbLf
        Dim lines() As String = TextBox1.Text.Split(vbLf)
        If lines.Length < 2 Then
            Exit Sub
        End If
        If TextBox1.Text.Length >= 500 Then
            '---clear until the last $---
            TextBox1.Text = TextBox1.Text.Substring(TextBox1.Text.LastIndexOf("$"))
        End If
        If lines(lines.Length - 2).StartsWith("$GPGGA") Or _
           lines(lines.Length - 2).StartsWith("$GPRMC") Then
            processGPSData(lines(lines.Length - 2))
        End If
    End Sub

    Private Sub processGPSData(ByVal str As String)
        Dim rawLatLng As Double
        Try
            '---separate the GPS data into various fields---
            Dim field() As String
            field = str.Split(",")
            Dim lat, lng As Double
            Select Case field(0)
                Case "$GPGGA"
                    '---latitude---
                    rawLatLng = Convert.ToDouble(field(2))
                    lat = (rawLatLng \ 100) + _
                          ((rawLatLng - ((rawLatLng \ 100) * 100)) / 60)

                    '---latitude is negative if South---
                    If field(3) = "S" Then
                        lat *= -1.0
                    End If

                    '---longitude---
                    rawLatLng = Convert.ToDouble(field(4))
                    lng = (rawLatLng \ 100) + _
                          ((rawLatLng - ((rawLatLng \ 100) * 100)) / 60)

                    '---longitude is negative if West---
                    If field(5) = "W" Then
                        lng *= -1.0
                    End If

                    '---display the lat and lng---
                    lblLat.Text = "Lat:" & lat
                    lblLng.Text = "Lng:" & lng

                    '---synchronize with the server---
                    sync.PerformSync(ServerIP, ID & ":" & lat & ":" & lng)

                Case "$GPRMC"
                    '---display the speed---
                    If field(7) = String.Empty Then
                        lblSpeed.Text = "Speed: 0 km/h"
                    Else
                        lblSpeed.Text = "Speed: " & _
                           (Convert.ToDouble(field(7)) * 1.85).ToString & " km/h"
                    End If
            End Select
        Catch
            MsgBox("An error has occurred")
        End Try
    End Sub

    '---Disconnect menu item---
    Private Sub MenuItem3_Click( _
       ByVal sender As System.Object, _
       ByVal e As System.EventArgs) _
       Handles MenuItem3.Click
        serialPort.Close()
        MenuItem1.Enabled = True  '---Connect GPS---
        MenuItem3.Enabled = False '---Disconnect---
    End Sub

    '---Server IP menu item---
    Private Sub MenuItem4_Click( _
       ByVal sender As System.Object, _
       ByVal e As System.EventArgs) _
       Handles MenuItem4.Click
        ServerIP = InputBox("Please enter the IP address of server", "Server IP")
    End Sub

    '---ID menu item---
    Private Sub MenuItem5_Click( _
       ByVal sender As System.Object, _
       ByVal e As System.EventArgs) _
       Handles MenuItem5.Click
        ID = InputBox("Please enter your ID", "ID")
    End Sub

    Private Sub Form1_Load( _
       ByVal sender As System.Object, _
       ByVal e As System.EventArgs) _
       Handles MyBase.Load
        MenuItem3.Enabled = False
    End Sub

End Class

⌨️ 快捷键说明

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