form1.frm

通过电脑串口读取传感器数据并进行实时显示

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   1905
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6765
   LinkTopic       =   "Form1"
   ScaleHeight     =   1905
   ScaleWidth      =   6765
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text6 
      Height          =   375
      Left            =   4920
      TabIndex        =   8
      Text            =   "Text6"
      Top             =   960
      Width           =   1215
   End
   Begin VB.TextBox Text5 
      Height          =   375
      Left            =   3480
      TabIndex        =   7
      Text            =   "Text5"
      Top             =   960
      Width           =   1215
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   0
      Top             =   240
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   4920
      TabIndex        =   6
      Text            =   "Text2"
      Top             =   360
      Width           =   1215
   End
   Begin VB.TextBox Text4 
      Height          =   375
      Left            =   2040
      TabIndex        =   5
      Text            =   "Text4"
      Top             =   960
      Width           =   1215
   End
   Begin VB.TextBox Text3 
      Height          =   375
      Left            =   600
      TabIndex        =   4
      Text            =   "Text3"
      Top             =   960
      Width           =   1215
   End
   Begin VB.Timer Timer3 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   6240
      Top             =   960
   End
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   6240
      Top             =   360
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   120
      Top             =   960
   End
   Begin VB.CommandButton Command6 
      Caption         =   "开串口"
      Height          =   375
      Left            =   3480
      TabIndex        =   3
      Top             =   360
      Width           =   1215
   End
   Begin MSComctlLib.StatusBar sbrStatus 
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   2
      Top             =   1530
      Width           =   6765
      _ExtentX        =   11933
      _ExtentY        =   661
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   2
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   3528
            MinWidth        =   3528
            Text            =   "状态："
            TextSave        =   "状态："
            Key             =   "Status"
            Object.ToolTipText     =   "Communications Port Status"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   12348
            MinWidth        =   12348
            Key             =   "Settings"
            Object.ToolTipText     =   "Settings"
         EndProperty
      EndProperty
   End
   Begin VB.TextBox Text1 
      Alignment       =   2  'Center
      Height          =   375
      Left            =   600
      TabIndex        =   1
      Top             =   360
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "发送"
      Height          =   375
      Left            =   2040
      TabIndex        =   0
      Top             =   360
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim c As Long
Dim e(0) As Byte
Dim temp As Variant
Dim Temp2 As Long
Dim ab(4) As Byte '字节数据类型数组，用来存储接收到的一组字节数据
    Dim av As Variant   '用来从接收缓冲区读取数据
    Dim i As Integer
    Dim j As Integer
    Dim w As Integer    '接收数据个数计数器

Private Sub Timer1_Timer()
MSComm1.Output = e '发送地址码1
Timer1.Enabled = True

End Sub

Private Sub Timer2_Timer()
e(0) = &H2 '设定左臂传感器地址为1
MSComm1.Output = e '发送地址码1
Timer2.Enabled = True
End Sub
Private Sub Timer3_Timer()
Timer3.Enabled = False
End Sub
Private Sub Command1_Click()
On Error Resume Next    '简单的错误处理
Dim l1 As Long
Dim l2 As Long
Dim r1 As Long
Dim r2 As Long
l1 = 65535
l2 = 0
r1 = 65535
r2 = 0

Do While (1)


c = 0 '清传感器原数值
e(0) = &H1 '设定左臂传感器地址为1
MSComm1.Output = e '发送地址码1
Timer1.Enabled = True
Do While c = 0 '等待传感返回数据
DoEvents
Loop
Timer1.Enabled = False

Text1.Text = c
If c < l1 Then
l1 = c
Text3.Text = l1
End If
If c > l2 Then
l2 = c
Text4.Text = l2
End If

c = 0 '清传感器原数值
e(0) = &H2 '设定左臂传感器地址为1
MSComm1.Output = e '发送地址码1
Timer1.Enabled = True
Do While c = 0 '等待传感返回数据
DoEvents
Loop
Timer1.Enabled = False
Text2.Text = c

If c < r1 Then
r1 = c
Text5.Text = r1
End If
If c > r2 Then
r2 = c
Text6.Text = r2
End If
Loop
End Sub
Private Sub Command2_Click()
Text1.Text = ""
Text1.SetFocus
End Sub

'设置并打开串口
Private Sub opencomm()
   With MSComm1
   If MSComm1.PortOpen Then
      sbrStatus.Panels("Settings").Text = "串口状态：COM1口 " & MSComm1.Settings
   Else
     .CommPort = 1            '使用COM1
     .Settings = "9600,N,8,1"       '设置通信口参数
     .InBufferSize = 4     '设置MSComm1接收缓冲区为40字节
     .OutBufferSize = 0    '设置MSComm1发送缓冲区为1字节
     .InputMode = comInputModeBinary   '设置接收数据模式为二进制形式
     .InputLen = 1    '设置Input 一次从接收缓冲读取字节数为1
     .PortOpen = True ' 打开串行口
        If Err Then        '错误处理
          MsgBox "串口通信无效"
          Exit Sub
        End If
      sbrStatus.Panels("Settings").Text = "串口状态：COM1口 " & MSComm1.Settings
    End If
     .InBufferCount = 0  '清除接收缓冲区
     .OutBufferCount = 0     '清除发送缓冲区
     .RThreshold = 1    '设置接收一个字节产生OnComm事件
   End With
End Sub

Private Sub cloodcom()
    If MSComm1.PortOpen Then
        MSComm1.PortOpen = False ' 关闭串行口
        sbrStatus.Panels("Settings").Text = "串口状态：COM1口 已关闭！ "


    Else
        sbrStatus.Panels("Settings").Text = "串口状态：COM1口 已关闭！ "

    End If
sbrStatus.Panels("Status").Text = "状态：等候命令...... "
End Sub

Private Sub Command6_Click()
Call opencomm  '打开串口
End Sub

' OnComm 事件控制.
Private Static Sub MSComm1_OnComm()
    Dim c1 As Long
    Dim c2 As Long
    Dim c3 As Long
    Dim c4 As Long
    Dim EVMsg$
    Dim ERMsg$ '根据事件分发处理
    With MSComm1
Select Case .CommEvent '判断MSComm1通信事件
       Case comEvReceive
             EVMsg$ = "—接收到数据"
             av = .Input '读取一个接收字节
             ab(1) = av(0) '转换保存到字节数据类型数组
          If ab(1) = &HF0 Then   '判断是否为数据开始标志
             .RThreshold = 0 '关闭OnComm事件接收
          Do
             DoEvents
          Loop Until .InBufferCount >= 3 '循环等待MSComm1接收缓冲区>=3个字节
   
             av = .Input '读取第二个数据字节（BCD码高位字节）
             ab(2) = av(0) '转换保存到字节数据类型数组
             av = .Input '读取第三个数据字节（BCD码低位字节）
             ab(3) = av(0) '转换保存到字节数据类型数组
             av = .Input '读取第四个数据字节（符号位字节）
             ab(4) = av(0) '转换保存到字节数据类型数组
             c1 = ab(2)
             c2 = ab(3)
             c3 = ab(4)
             c4 = c1 Xor c2

              If c3 = c4 Then '如果接收数据正确
                 If c2 > 254 Then
                 .Output = e
                 Else
                 c = c1 + c2 * 256

                 End If
               Else
                 .Output = e
               End If
           Else
             EVMsg$ = "—数据错误！"
           End If
          .InBufferCount = 0  '清除接收缓冲区
          .OutBufferCount = 0     '清除发送缓冲区
          .RThreshold = 1    '设置接收一个字节产生OnComm事件
        Case comEvSend
            EVMsg$ = "—发送缓冲区中数据少于Sthreshold个"
        Case comEvCTS
            EVMsg$ = "—Clear To Send信号线状态发生变化"
        Case comEvDSR
            EVMsg$ = "—Data Set Ready信号线状态从1变到0"
        Case comEvCD
            EVMsg$ = "—Carrier Detect信号线状态发生变化"
        Case comEvRing
            EVMsg$ = "—检测到振铃信号"
        Case comEvEOF
            EVMsg$ = "—接受到文件结束符"
        Case comBreak
            ERMsg$ = "—接受到一个中断信号"
        Case comCDTO
            ERMsg$ = "—载波检测超时！"
        Case comCTSTO
            ERMsg$ = "—Clear To Send信号超时！"
        Case comDCB
            ERMsg$ = "—检索串口的设备控制块时发生错误！"
        Case comDSRTO
            ERMsg$ = "—Data Set Ready信号超时！"
        Case comFrame
            ERMsg$ = "—帧错误！"
        Case comOverrun
            ERMsg$ = "—串口超速！"
        Case comRxOver
            ERMsg$ = "—接受缓冲区溢出！"
        Case comRxParity
            ERMsg$ = "—奇偶校验错！"
        Case comTxFull
            ERMsg$ = "—发送缓冲区溢出！"
        Case Else
            ERMsg$ = "—未知错误！"
            
    End Select
    End With
    
    If Len(EVMsg$) Then
        '显示
        sbrStatus.Panels("Settings").Text = "串口状态：COM1口 " & MSComm1.Settings & EVMsg$
    ElseIf Len(ERMsg$) Then
        '显示 错误信息
        sbrStatus.Panels("Settings").Text = "串口状态：COM1口 " & ERMsg$
    End If
End Sub
  Public Function Hex2Dec(ByVal x As String) As String
  
  Dim dec, temp
  Dim remain As Double, i
  Dim n  As Integer
  
  Do
  If Left(x, 1) = "0" Then
  x = Mid(x, 2)
  Else
  Exit Do
  End If
  Loop
  If Len(x) > 8 Then
  MsgBox "输入的数字超过上限", vbExclamation
  Exit Function
  End If
  n = Len(x)
  For i = 1 To n
  temp = 16 ^ (n - i)
  temp = Val("&H" & Mid(x, i, 1)) * temp
  dec = dec + temp
  Next i
  If IsEmpty(dec) Then dec = 0
  Hex2Dec = CStr(dec)
  End Function