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

📄 recdata.frm

📁 利用vb的Mscomm控件实现全站仪及GPS的数据通信程序
💻 FRM
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form RecData 
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   5  'Sizable ToolWindow
   Caption         =   "GPS接受数据"
   ClientHeight    =   4830
   ClientLeft      =   60
   ClientTop       =   300
   ClientWidth     =   5325
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   8.52
   ScaleMode       =   7  'Centimeter
   ScaleWidth      =   9.393
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      BackColor       =   &H00E0E0E0&
      Height          =   4935
      Left            =   0
      TabIndex        =   0
      Top             =   -120
      Width           =   5295
      Begin MSCommLib.MSComm MSComm1 
         Left            =   4200
         Top             =   1200
         _ExtentX        =   1005
         _ExtentY        =   1005
         _Version        =   393216
         DTREnable       =   -1  'True
      End
      Begin VB.Timer Timer1 
         Left            =   3600
         Top             =   1320
      End
      Begin VB.TextBox TDisplay 
         Height          =   735
         Left            =   360
         MultiLine       =   -1  'True
         TabIndex        =   18
         Top             =   3960
         Width           =   4575
      End
      Begin VB.CommandButton CEnd 
         Caption         =   "结束"
         Height          =   375
         Left            =   3720
         TabIndex        =   16
         Top             =   3000
         Width           =   1215
      End
      Begin VB.CommandButton CRec 
         Caption         =   "接受"
         Height          =   375
         Left            =   3720
         TabIndex        =   15
         Top             =   2160
         Width           =   1215
      End
      Begin VB.TextBox TLevLow 
         Height          =   270
         Left            =   2280
         TabIndex        =   14
         Top             =   3120
         Width           =   1215
      End
      Begin VB.TextBox TSateNum 
         Height          =   270
         Left            =   360
         TabIndex        =   12
         Top             =   3120
         Width           =   1215
      End
      Begin VB.TextBox InterTime 
         Height          =   270
         Left            =   360
         TabIndex        =   10
         Top             =   2280
         Width           =   3135
      End
      Begin VB.TextBox TLONG 
         Height          =   270
         Left            =   2280
         TabIndex        =   8
         Top             =   1560
         Width           =   1215
      End
      Begin VB.TextBox TLAT 
         Height          =   270
         Left            =   360
         TabIndex        =   7
         Top             =   1560
         Width           =   1215
      End
      Begin VB.TextBox TS 
         Height          =   270
         Left            =   3840
         TabIndex        =   4
         Top             =   720
         Width           =   735
      End
      Begin VB.HScrollBar HScroll1 
         Height          =   255
         Left            =   360
         TabIndex        =   2
         Top             =   720
         Width           =   3135
      End
      Begin VB.Label Label8 
         BackColor       =   &H00E0E0E0&
         Caption         =   "NEMA_0183 格式"
         Height          =   255
         Left            =   1560
         TabIndex        =   17
         Top             =   3600
         Width           =   1455
      End
      Begin VB.Label Label7 
         BackColor       =   &H00E0E0E0&
         Caption         =   "水平减弱值"
         Height          =   255
         Left            =   2280
         TabIndex        =   13
         Top             =   2760
         Width           =   1095
      End
      Begin VB.Label Label6 
         BackColor       =   &H00E0E0E0&
         Caption         =   "使用卫星数"
         Height          =   255
         Left            =   360
         TabIndex        =   11
         Top             =   2760
         Width           =   1215
      End
      Begin VB.Label Label5 
         BackColor       =   &H00E0E0E0&
         Caption         =   "国际时间"
         Height          =   255
         Left            =   1560
         TabIndex        =   9
         Top             =   2040
         Width           =   735
      End
      Begin VB.Label Label4 
         BackColor       =   &H00E0E0E0&
         Caption         =   "经度"
         Height          =   255
         Left            =   2280
         TabIndex        =   6
         Top             =   1200
         Width           =   495
      End
      Begin VB.Label label3 
         BackColor       =   &H00E0E0E0&
         Caption         =   "纬度"
         Height          =   255
         Left            =   360
         TabIndex        =   5
         Top             =   1200
         Width           =   495
      End
      Begin VB.Label Label2 
         BackColor       =   &H00E0E0E0&
         Caption         =   "单位:秒"
         Height          =   255
         Left            =   3840
         TabIndex        =   3
         Top             =   360
         Width           =   855
      End
      Begin VB.Label Label1 
         BackColor       =   &H00E0E0E0&
         Caption         =   "请选择间隔时间"
         Height          =   255
         Left            =   360
         TabIndex        =   1
         Top             =   360
         Width           =   1455
      End
   End
End
Attribute VB_Name = "RecData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim strINIFileName As String, strSecName As String
Dim strKey As String, strINI As String
Dim intN As Integer

Private Sub CEnd_Click()
Timer1.Enabled = False
End Sub

Private Sub CRec_Click()
Timer1.Enabled = True
End Sub

Private Sub Form_Load()
On Error Resume Next
Form1.Show
Timer1.Enabled = False
Timer1.Interval = 1000
TS.Text = "1"
'With MSComm1
     '.InputLen = 0
     '.CommPort = 2
    ' .Settings = "9600,n,8,1"
     '波特率,奇偶校验位,一次传输8位,一个停止位
    ' .PortOpen = True
'End With
With HScroll1
     .Max = 10
     .Min = 1
     .LargeChange = 2
     .SmallChange = 1
End With

End Sub

Private Sub HScroll1_Change()
Timer1.Interval = HScroll1.Value * 1000
TS.Text = Str$(HScroll1.Value)
End Sub

Private Sub Timer1_Timer()
Dim StrGPS_Data As String
Dim kLAT As String, kLONG As String, kGGA As String
Dim strT3, strT4 As String
Static iniI As Integer
iniI = iniI + 1
'StrGPS_Data = MSComm1.Input
strINI = String(255, 0)
strINIFileName = App.Path & "\GPS数据.ini"
strSecName = "虚拟GPS"
strKey = "KEY"
intN = GetPrivateProfileString(strSecName, strKey & iniI, "******", strINI, Len(strINI), strINIFileName)
StrGPS_Data = strINI
kGGA = InStr(StrGPS_Data, "GGA")
If kGGA < 3 Then Exit Sub
TDisplay.Text = StrGPS_Data
kLAT = InStr(StrGPS_Data, "N")
kLONG = InStr(StrGPS_Data, "E")
If kLAT > 10 Then
        strT3 = Mid(StrGPS_Data, kLAT - 10, 2) & "度" & Mid(StrGPS_Data, kLAT - 8, 7) & "分"
        TLAT.Text = strT3
End If
If kLONG > 11 Then
        strT4 = Mid(StrGPS_Data, kLONG - 10, 2) & "度" & Mid(StrGPS_Data, kLONG - 8, 7) & "分"
        TLONG.Text = strT4
End If
InterTime.Text = Mid(StrGPS_Data, kGGA + 4, 2) & "时" & Mid(StrGPS_Data, kGGA + 6, 2) & "分" & Mid(StrGPS_Data, kGGA + 8, 2) & "秒"
TSateNum.Text = Mid(StrGPS_Data, kGGA + 38, 2)
TLevLow.Text = Mid(StrGPS_Data, kGGA + 41, 4)
iniI = iniI + 1
End Sub

⌨️ 快捷键说明

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