📄 pc与智能仪器串口通讯.frm
字号:
Call tabinit ' 初始化表格
If MSComm1.PortOpen = True Then
Timer1.Interval = 1000 * Txttime.Text ' 设置间隔采样时间
CmdStart.Caption = "重新采集"
CmdStop.Enabled = True
CmdStop.Caption = "停止采集"
Shpstate.FillColor = &HFF&
mark = True
Call renew ' 重新开始
End If
End Sub
'-----------------------------------------------
' 默认设置
'-----------------------------------------------
Sub setAcquiescence()
Txttimes.Text = "200" ' 恢复默认值
Txttime.Text = "1"
Timer1.Enabled = False
CmdStart.Caption = "开始采集"
CmdStop.Enabled = False
Shpstate.FillColor = &H808080 ' 填充停止状态
Call renew ' 重新开始
End Sub
'-----------------------------------------------
' 停止温度采集
'-----------------------------------------------
Private Sub CmdStop_Click() ' 停止采集
If mark = True Then
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
mark = False
Timer1.Enabled = False
CmdStop.Caption = "继续采集"
Shpstate.FillColor = &H808080
Else
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True
mark = True
Timer1.Enabled = True
CmdStop.Caption = "停止采集"
Shpstate.FillColor = &HFF&
End If
End Sub
'串口初始化
'在窗体的Load事件中加入下列代码对串口进行初始化:
'-----------------------------------------------
' 载入窗体
'-----------------------------------------------
Private Sub Form_Load()
On Error GoTo err:
MSComm1.CommPort = 1 ' 设置串口
MSComm1.InputMode = comInputModeBinary ' 二进制输入模式
MSComm1.RThreshold = 1 ' 接收1个字符触法OnComm 事件
MSComm1.SThreshold = 1 ' 发送1个字符触法OnComm 事件
MSComm1.Settings = "9600,n,8,2" ' 设置波特率
Call tabinit ' 调用表格初始化子程序
Call ScaleSys ' 绘制坐标系
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True ' 打开串口
mark = True
CmdStop.Enabled = False
Exit Sub
err:
Select Case err.Number
Case comPortAlreadyOpen ' 如果串口已经打开，则提示
MsgBox "没有发现此串口或被占用", 49, "温度采集系统"
Case Else
MsgBox "没有发现此串口或被占用", 49, "温度采集系统"
End Select
err.Clear
End Sub
'-----------------------------------------------
' 接收触法事件
'-----------------------------------------------
'获取温度测量值并显示
'每发送一次指令，触发下面事件，返回数据串
Private Sub MSComm1_OnComm()
Dim Inbyte() As Byte ' 接收数据暂存
Dim buffer As String ' 温度数据缓冲
Dim datatemp2a, datatemp2b As String ' 两字节进制温度数据
Dim datatemp2 As String ' 十六进制温度数据
Dim count As Integer ' 接收个数计数
If num > Txttimes.Text - 1 Then ' 接收个数判断
Timer1.Enabled = False ' 接收完毕
Shpstate.FillColor = &H80FF&
Exit Sub
End If
'读取仪表返回数据串
Select Case MSComm1.CommEvent
Case comEvReceive
count = MSComm1.InBufferCount ' 接收温度数据个数，两字节，低位在前
Inbyte = MSComm1.Input ' 接收温度数据
If count <> 2 Then Exit Sub ' 不是两字节，表示接收错误，跳出程序
counter = counter + 1 ' 基数器加1
For i = LBound(Inbyte) To UBound(Inbyte) ' 把接收的数据安十六进制格式放入缓冲中
buffer = buffer + Hex(Inbyte(i)) + Chr(32)
Next i
End Select
'获取十进制测量数据
If Len(Trim(Mid(buffer, 1, 2))) = 1 Then
datatemp(num) = Val("&H" & Mid(buffer, 3, 3) & Str("0") & Mid(buffer, 1, 2)) * 0.0625
Else
datatemp(num) = Val("&H" & Mid(buffer, 3, 3) & Mid(buffer, 1, 2)) * 0.0625
End If
'获取十六进制测量数据
If Len(Trim(Mid(buffer, 1, 2))) = 1 Then
datatemp2a = Str("0") & Trim(Mid(buffer, 1, 2))
Else
datatemp2a = Mid(buffer, 1, 2)
End If
If Len(Trim(Mid(buffer, 4, 2))) = 1 Then
datatemp2b = Str("0") & Trim(Mid(buffer, 3, 2))
Else
datatemp2b = Mid(buffer, 4, 2)
End If
datatemp2 = datatemp2a & " " & datatemp2b
'显示测量温度值
If counter = num + 1 Then ' If datatemp(num) <> 0 Then 不能显示零度,别的正常
Grid.Col = 1: Grid.Row = num + 1
Grid.Text = Format$(datatemp(num), "0.0")
If counter > 13 Then Grid.TopRow = counter - 12 ' 控制滚动条的滚动
TempText = Format$(datatemp(num), "0.0") ' 10进制显示,保留一位小数
num = num + 1
Call cal ' 调用计算极值、平均值子程序
Call draw ' 调用绘曲线过程
End If
End Sub
'-----------------------------------------------
' 统计计算
'-----------------------------------------------
'计算极值、平均值
Sub cal()
On Error GoTo err
Sum = 0
Max = datatemp(0): Min = Max
For i = 0 To num - 1
If datatemp(i) >= Max Then Max = datatemp(i)
If datatemp(i) <= Min Then Min = datatemp(i)
Sum = Sum + datatemp(i)
Next i
aver = Sum / num
MaxText.Text = Format$(Max, "0.0")
MinText.Text = Format$(Min, "0.0")
AverText.Text = Format$(aver, "0.0")
err:
End Sub
'-----------------------------------------------
' 温度曲线绘制
'-----------------------------------------------
'绘制温度实时变化曲线
Private Sub draw()
Picture1.DrawWidth = 2 ' 设置线宽
Picture1.DrawStyle = vbSolid
For i = 1 To num - 1
X1 = (i - 1): Y1 = datatemp(i - 1)
X2 = i: Y2 = datatemp(i)
Picture1.Line (X1, Y1)-(X2, Y2), QBColor(0) ' 绘制温度曲线
Next i
End Sub
'-----------------------------------------------
' 重新采集数据
'-----------------------------------------------
Private Sub renew()
If num = 0 Then Exit Sub
TempText.Text = "": AverText.Text = ""
MinText.Text = "": MaxText.Text = ""
Grid.Clear
Picture1.Cls
Call ScaleSys
For i = 0 To num - 1
datatemp(i) = 0
Next i
num = 0
counter = 0
Call tabinit '数据表格初始化
End Sub
'-----------------------------------------------
' 数据表格初始化
'-----------------------------------------------
Public Sub tabinit()
Grid.Cols = 2 ' 两列
Grid.Rows = Txttimes.Text + 1 ' Rows 的值必须至少比 FixedRows 的值大一
Grid.ColWidth(0) = 650 ' 设置表格宽度
Grid.ColWidth(1) = 850
Grid.Col = 0
For i = 1 To Txttimes.Text
Grid.Row = i
Grid.Text = " " + Str$(i)
Next i
Grid.Row = 0
Grid.Col = 0: Grid.Text = " 序号"
Grid.Col = 1: Grid.Text = " 温度值"
Grid.TopRow = 1 '置在第一页
Grid.LeftCol = 1
End Sub
'-----------------------------------------------
' 定时发送采集标志
'-----------------------------------------------
'每隔 x ms向仪表发送读数据命令串
'每台仪表有一个仪表号，PC机通过仪表号来识别网上的多台仪表
'程序中仪表号（即地址代号）要与仪表设定值一致，否则不能返回数据。
Private Sub Timer1_Timer()
MSComm1.Output = "s" ' 发送开始标志
End Sub
'-----------------------------------------------
' 卸载窗体
'-----------------------------------------------
Private Sub Cmdquit_Click()
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False ' 关闭串口
Unload Me ' 卸载窗体
End
End Sub
'-----------------------------------------------
' 串口设置
'-----------------------------------------------
Sub setCom()
On Error GoTo err:
MSComm1.CommPort = Val(Mid(Txtcom.Text, 4, 1)) ' 设置串口
MSComm1.Settings = TxtBaudRate.Text & ",n,8,2" ' 设置波特率
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True ' 打开串口
Timer1.Enabled = True ' 开定时器
Shpstate.FillColor = &HFF&
Exit Sub
err:
Select Case err.Number
Case comPortAlreadyOpen '如果串口已经打开，则提示
MsgBox "没有发现此串口或被占用", 49, "温度采集系统"
Case Else
MsgBox "没有发现此串口或被占用", 49, "温度采集系统"
End Select
Shpstate.FillColor = &H808080 ' 填充停止状态
Timer1.Enabled = False ' 关闭定时器
CmdStart.Caption = "开始采集"
CmdStop.Enabled = False
Picture1.Cls
Call renew ' 初始化表格
Call ScaleSys ' 建立坐标系
err.Clear
End Sub
'-----------------------------------------------
' 建立图像坐标系
'-----------------------------------------------
Sub ScaleSys() ' 坐标系
Picture1.AutoRedraw = True ' 自动重绘有效
Picture1.DrawWidth = 1 ' 线宽1个像素
Picture1.ScaleMode = vbPixels ' 像素为单位
Picture1.Scale (0, 125)-(200, -50) ' 坐标系
Picture1.DrawStyle = vbDot ' 点线
' 横坐标
Picture1.Line (0, 0)-(200, 0), RGB(130, 130, 130)
Picture1.Line (0, 25)-(200, 25), RGB(130, 130, 130)
Picture1.Line (0, 50)-(200, 50), RGB(130, 130, 130)
Picture1.Line (0, 75)-(200, 75), RGB(130, 130, 130)
Picture1.Line (0, 100)-(200, 100), RGB(130, 130, 130)
Picture1.Line (0, -25)-(200, -25), RGB(130, 130, 130)
' 纵坐标
Picture1.Line (25, 125)-(25, -50), RGB(130, 130, 130)
Picture1.Line (50, 125)-(50, -50), RGB(130, 130, 130)
Picture1.Line (75, 125)-(75, -50), RGB(130, 130, 130)
Picture1.Line (100, 125)-(100, -50), RGB(130, 130, 130)
Picture1.Line (125, 125)-(125, -50), RGB(130, 130, 130)
Picture1.Line (150, 125)-(150, -50), RGB(130, 130, 130)
Picture1.Line (175, 125)-(175, -50), RGB(130, 130, 130)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -