📄 pc&xmt.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form frmMain
BorderStyle = 3 'Fixed Dialog
Caption = "PC机与智能仪表串口通信程序V1.0"
ClientHeight = 3975
ClientLeft = 4800
ClientTop = 3075
ClientWidth = 5640
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3975
ScaleWidth = 5640
ShowInTaskbar = 0 'False
Begin VB.Frame Frame2
Caption = "报警指示"
Height = 1095
Left = 360
TabIndex = 11
Top = 1800
Width = 3135
Begin VB.Label Label4
Caption = "下限灯："
Height = 255
Left = 1680
TabIndex = 13
Top = 480
Width = 735
End
Begin VB.Label Label3
Caption = "上限灯："
Height = 255
Left = 120
TabIndex = 12
Top = 480
Width = 735
End
Begin VB.Shape alarm1
BackColor = &H00FFFFFF&
BorderColor = &H00404040&
FillColor = &H0080FF80&
FillStyle = 0 'Solid
Height = 495
Left = 960
Shape = 2 'Oval
Top = 360
Width = 495
End
Begin VB.Shape alarm2
BackColor = &H00FFFFFF&
BorderColor = &H00404040&
FillColor = &H0080FF80&
FillStyle = 0 'Solid
Height = 495
Left = 2520
Shape = 2 'Oval
Top = 360
Width = 495
End
End
Begin VB.CommandButton Cmdquit
Caption = "关 闭"
Height = 375
Left = 3960
TabIndex = 10
Top = 2280
Width = 1215
End
Begin VB.Frame Frame3
Caption = "串口状态"
Height = 855
Left = 360
TabIndex = 7
Top = 3000
Width = 3135
Begin VB.OptionButton opencom
Caption = "打开串口"
Height = 375
Left = 360
TabIndex = 9
Top = 360
Width = 1095
End
Begin VB.OptionButton closecom
Caption = "关闭串口"
Height = 375
Left = 1800
TabIndex = 8
Top = 360
Value = -1 'True
Width = 1095
End
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1000
Left = 4680
Top = 3240
End
Begin VB.CommandButton Cmdauto
Caption = "自动发送"
Height = 375
Left = 3960
TabIndex = 6
Top = 1440
Width = 1215
End
Begin VB.CommandButton Cmdman
Caption = "手动发送"
Height = 375
Left = 3960
TabIndex = 5
Top = 600
Width = 1215
End
Begin VB.Frame Frame1
Caption = "显示方式"
Height = 855
Left = 360
TabIndex = 2
Top = 840
Width = 3135
Begin VB.OptionButton dis10
Caption = "十进制"
Height = 375
Left = 480
TabIndex = 4
Top = 360
Value = -1 'True
Width = 975
End
Begin VB.OptionButton dis16
Caption = "十六进制"
Height = 375
Left = 1800
TabIndex = 3
Top = 360
Width = 1095
End
End
Begin VB.TextBox Tdata
Alignment = 2 'Center
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1680
TabIndex = 0
Top = 240
Width = 1455
End
Begin MSCommLib.MSComm MSComm1
Left = 3840
Top = 3120
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
RThreshold = 1
BaudRate = 4800
StopBits = 2
SThreshold = 1
InputMode = 1
End
Begin VB.Label Label2
Caption = "℃"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3240
TabIndex = 14
Top = 315
Width = 375
End
Begin VB.Label Label1
Caption = "测量温度值:"
Height = 255
Left = 480
TabIndex = 1
Top = 360
Width = 1095
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'定义变量
Dim dataway As Integer '数值显示方式
Dim datatemp As Single '温度采样值
'程序初始化
Private Sub Form_Load()
MSComm1.CommPort = 1 '设置通信端口号为COM1
MSComm1.InputMode = 1 '以二进制格式读取数据
MSComm1.RThreshold = 1 '设置并返回的要接收的字符数
MSComm1.SThreshold = 1 '设置并返回传输缓冲区中允许的最小字符数
MSComm1.Settings = "4800,n,8,2" '设置串口参数
alarm1.FillColor = QBColor(10)
alarm2.FillColor = QBColor(10)
dataway = 1
End Sub
'打开串口
Private Sub opencom_Click()
MSComm1.PortOpen = True
End Sub
'关闭串口
Private Sub closecom_Click()
MSComm1.PortOpen = False
Timer1.Enabled = False
End Sub
'十进制显示
Private Sub dis10_Click()
dataway = 1
Call order
End Sub
'十六进制显示
Private Sub dis16_Click()
dataway = 2
Call order
End Sub
'手动间断采集
Private Sub Cmdman_Click()
If MSComm1.PortOpen = False Then
p% = MsgBox("串口未打开！", 16, "提示")
Exit Sub
End If
Timer1.Enabled = False
Call order
End Sub
'自动连续采集
Private Sub Cmdauto_Click()
If MSComm1.PortOpen = False Then
p% = MsgBox("串口未打开！", 16, "提示")
Exit Sub
End If
Timer1.Enabled = True
Call order
End Sub
'周期发出请求指令
Private Sub Timer1_Timer()
Call order
End Sub
'向仪表发送读数据命令串
Sub order()
MSComm1.Output = Chr(&H8282) & Chr(&H52) & Chr(&HC)
End Sub
'每发送一次指令，触发下面事件，返回数据串
Private Sub MSComm1_OnComm()
Dim Inbyte() As Byte
Dim buffer As String
Dim datatemp2a As String
Dim 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 = Val("&H" & Mid(buffer, 3, 2) & Str("0") & Mid(buffer, 1, 2)) * 0.1
Else
datatemp = 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 <> 0 Then
If dataway = 1 Then Tdata.Text = Format$(datatemp, "0.0")
If dataway = 2 Then Tdata.Text = datatemp2
Call alarm
End If
End Sub
'上、下限报警指示
Sub alarm()
If datatemp >= 30 Then
alarm1.FillColor = QBColor(12)
End If
If datatemp <= 25 Then
alarm2.FillColor = QBColor(12)
End If
If datatemp > 25 And datatemp < 30 Then
alarm1.FillColor = QBColor(10)
alarm2.FillColor = QBColor(10)
End If
End Sub
'关闭程序
Private Sub Cmdquit_Click()
MSComm1.PortOpen = False '关闭串口
Unload frmMain
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -