📄 form1.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
BorderStyle = 3 'Fixed Dialog
Caption = "PC机与智能仪器串口通信"
ClientHeight = 3885
ClientLeft = 45
ClientTop = 435
ClientWidth = 6735
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3885
ScaleWidth = 6735
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin MSCommLib.MSComm MSComm1
Left = 5565
Top = 3150
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin VB.Timer Timer1
Interval = 500
Left = 4830
Top = 3255
End
Begin VB.CommandButton Cmdquit
Caption = "关 闭"
Height = 375
Left = 2730
TabIndex = 0
Top = 3255
Width = 1215
End
Begin VB.PictureBox Picture1
BackColor = &H00FFFFFF&
Height = 2895
Left = 105
ScaleHeight = 2835
ScaleWidth = 4035
TabIndex = 9
Top = 105
Width = 4095
End
Begin VB.Frame Frame2
Caption = "报警指示"
Height = 1425
Left = 4305
TabIndex = 6
Top = 1575
Width = 2355
Begin VB.Label Label4
Caption = "下限灯："
Height = 255
Left = 210
TabIndex = 8
Top = 945
Width = 735
End
Begin VB.Label Label3
Caption = "上限灯："
Height = 255
Left = 210
TabIndex = 7
Top = 420
Width = 735
End
Begin VB.Shape Shape2
FillColor = &H00FFFFFF&
FillStyle = 0 'Solid
Height = 375
Left = 1260
Shape = 3 'Circle
Top = 825
Width = 495
End
Begin VB.Shape Shape1
FillColor = &H00FFFFFF&
FillStyle = 0 'Solid
Height = 375
Left = 1260
Shape = 3 'Circle
Top = 315
Width = 495
End
End
Begin VB.Frame Frame1
Caption = "温度显示"
Height = 1425
Left = 4305
TabIndex = 1
Top = 105
Width = 2355
Begin VB.TextBox Text2
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1050
TabIndex = 3
Top = 840
Width = 975
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1050
TabIndex = 2
Top = 345
Width = 975
End
Begin VB.Label Label2
Caption = "16进制："
Height = 255
Left = 210
TabIndex = 5
Top = 945
Width = 735
End
Begin VB.Label Label1
Caption = "10进制："
Height = 255
Left = 210
TabIndex = 4
Top = 465
Width = 735
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'定义窗体级变量
'在显示、绘图、报警等过程中使用
Dim datatemp(1000) As Single '用于存储温度采样值
Dim num As Integer '用于存储采样值个数
'串口初始化
'在窗体的Load事件中加入下列代码对串口进行初始化:
Private Sub Form_Load()
MSComm1.CommPort = 1
MSComm1.InputMode = 1
MSComm1.RThreshold = 1
MSComm1.SThreshold = 1
MSComm1.Settings = "4800,n,8,2"
MSComm1.PortOpen = True
Shape1.FillColor = QBColor(10)
Shape2.FillColor = QBColor(10)
End Sub
'每隔500ms向仪表发送读数据命令串
'每台仪表有一个仪表号，PC机通过仪表号来识别网上的多台仪表
'如果有多台仪表，要求网上的任意两台仪表的编号不能相同。
'程序中仪表号（即地址代号）要与仪表设定值一致，否则不能返回数据。
Private Sub Timer1_Timer()
MSComm1.Output = Chr(&H8282) & Chr(&H52) & Chr(&HC)
End Sub
'获取温度测量值并显示
'每发送一次指令，触发下面事件，返回数据串
Private Sub MSComm1_OnComm()
Dim Inbyte() As Byte
Dim buffer As String
Dim datatemp2a, datatemp2b As String
Dim datatemp2 As String
'读取仪表返回数据串
Select Case MSComm1.CommEvent
Case comEvReceive
Inbyte = MSComm1.Input
For i = LBound(Inbyte) To UBound(Inbyte)
buffer = buffer + Hex(Inbyte(i)) + Chr(32)
Next i
Case comEvSend
End Select
'获取十进制测量数据
If Len(Trim(Mid(buffer, 1, 2))) = 1 Then
datatemp(num) = Val("&H" & Mid(buffer, 3, 2) & Str("0") & Mid(buffer, 1, 2)) * 0.1
Else
datatemp(num) = Val("&H" & Mid(buffer, 3, 2) & Mid(buffer, 1, 2)) * 0.1
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, 3, 2))) = 1 Then
datatemp2b = Str("0") & Trim(Mid(buffer, 3, 2))
Else
datatemp2b = Mid(buffer, 3, 2)
End If
datatemp2 = datatemp2a & " " & datatemp2b
'显示测量温度值
If datatemp(num) <> 0 Then
Text1.Text = Format$(datatemp(num), "0.0") '10进制显示,保留一位小数
Text2.Text = datatemp2 '16进制显示
Call draw '调用绘曲线过程
Call alarm '调用报警指示过程
num = num + 1
End If
End Sub
'绘制温度实时变化曲线
Private Sub draw()
Picture1.Cls
Picture1.DrawWidth = 1
Picture1.BackColor = QBColor(15)
Picture1.Scale (0, 50)-(200, 0)
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 alarm()
If datatemp(num) >= 30 Then
Shape1.FillColor = QBColor(12)
End If
If datatemp(num) <= 25 Then
Shape2.FillColor = QBColor(12)
End If
If datatemp(num) > 25 And datatemp(num) < 30 Then
Shape1.FillColor = QBColor(10)
Shape2.FillColor = QBColor(10)
End If
End Sub
'当退出程序时，一定要关闭串行口
Private Sub Cmdquit_Click()
MSComm1.PortOpen = False '关闭串口
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -