📄 form1.frm
字号:
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 21.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 435
Index = 2
Left = -69840
TabIndex = 3
Top = 1800
Width = 240
End
Begin VB.Label LabelName
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "测量值"
BeginProperty Font
Name = "宋体"
Size = 21.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 435
Index = 0
Left = 2040
TabIndex = 2
Top = 1080
Width = 1350
End
Begin VB.Label Label
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 21.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 435
Index = 0
Left = 4560
TabIndex = 1
Top = 1080
Width = 240
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private data0(0) As String
Private data1(1) As String
Private data2(5) As String
Private data3(5) As String
Private data4(5) As String
Private strInputData As String '输入数据
Private intN As Integer '循环变量
Private bytReceive() As Byte '发送数据
Private bytSend() As Byte '接收数据
Private lngSendCrc16 As Long '发送数据的Crc_16校验
Private lngReceiveCrc16 As Long '接收数据的Crc_16校验
Private bytCrcH As Byte '接收数据的校验的高位
Private bytCrcL As Byte '接收数据的校验的低位
Private Sub Command0_Click()
Call 写入数据("0204", "0", "0")
End Sub
Private Sub Command1_Click()
Call 写入数据("0204", "1", "0")
End Sub
Private Sub Command2_Click()
Call 写入数据("0204", "2", "0")
End Sub
Private Sub Form_Load()
MSComm1.CommPort = 1
MSComm1.Settings = "9600,N,8,1"
MSComm1.InputMode = comInputModeBinary
MSComm1.PortOpen = True
Timer1.Interval = 100
End Sub
Private Sub Timer1_Timer()
data0(0) = 读取数据("0000")
data1(0) = 读取数据("0100")
data1(1) = 读取数据("0104")
data2(0) = 读取数据("0200")
data2(1) = 读取数据("0204")
data2(2) = 读取数据("0208")
data2(3) = 读取数据("020C")
data2(4) = 读取数据("0210")
data2(5) = 读取数据("0214")
data3(0) = 读取数据("0300")
data3(1) = 读取数据("0304")
data3(2) = 读取数据("0308")
data3(3) = 读取数据("030C")
data3(4) = 读取数据("0310")
data3(5) = 读取数据("0314")
data4(0) = 读取数据("0400")
data4(1) = 读取数据("0404")
data4(2) = 读取数据("0408")
data4(3) = 读取数据("040C")
data4(4) = 读取数据("0410")
data4(5) = 读取数据("0414")
Label(0).Caption = data0(0)
Label(1).Caption = data1(0)
Label(2).Caption = data1(1)
Label(3).Caption = data2(0)
Label(4).Caption = data2(1)
Label(5).Caption = data2(2)
Label(6).Caption = data2(3)
Label(7).Caption = data2(4)
Label(8).Caption = data2(5)
Label(9).Caption = data3(0)
Label(10).Caption = data3(1)
Label(11).Caption = data3(2)
Label(12).Caption = data3(3)
Label(13).Caption = data3(4)
Label(14).Caption = data3(5)
Label(15).Caption = data4(0)
Label(16).Caption = data4(1)
Label(17).Caption = data4(2)
Label(18).Caption = data4(3)
Label(19).Caption = data4(4)
Label(20).Caption = data4(5)
End Sub
Private Sub Label_Click(Index As Integer)
Select Case Index
Case 1
strInputData = InputBox("符号:" & vbLf & "地址:0100" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
Call 写入数据("0100", strInputData, data2(1))
Case 2
strInputData = InputBox("符号:" & vbLf & "地址:0104" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
Call 写入数据("0104", strInputData, data2(1))
Case 3
strInputData = InputBox("符号:" & vbLf & "地址:0200" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
Call 写入数据("0200", strInputData, "0")
' Case 4
' strInputData = InputBox("符号:" & vbLf & "地址:0204" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
' Call 写入数据("0204", strInputData)
Case 5
strInputData = InputBox("符号:" & vbLf & "地址:0208" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
Call 写入数据("0208", strInputData, data2(1))
Case 6
strInputData = InputBox("符号:" & vbLf & "地址:020C" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
Call 写入数据("020C", strInputData, data2(1))
Case 7
strInputData = InputBox("符号:" & vbLf & "地址:0210" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
Call 写入数据("0210", strInputData, "0")
Case 8
strInputData = InputBox("符号:" & vbLf & "地址:0214" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
Call 写入数据("0214", strInputData, "0")
Case 9
strInputData = InputBox("符号:" & vbLf & "地址:0300" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
Call 写入数据("0300", strInputData, "0")
Case 10
strInputData = InputBox("符号:" & vbLf & "地址:0304" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
Call 写入数据("0304", strInputData, data2(1))
Case 11
strInputData = InputBox("符号:" & vbLf & "地址:0308" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
Call 写入数据("0308", strInputData, data2(1))
Case 12
strInputData = InputBox("符号:" & vbLf & "地址:030C" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
Call 写入数据("030C", strInputData, "0")
Case 13
strInputData = InputBox("符号:" & vbLf & "地址:0310" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
Call 写入数据("0310", strInputData, data2(1))
Case 14
strInputData = InputBox("符号:" & vbLf & "地址:0314" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
Call 写入数据("0314", strInputData, data2(1))
' Case 15
' strInputData = InputBox("符号:" & vbLf & "地址:0300" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
' Call 写入数据("0300", strInputData, "0")
' Case 16
' strInputData = InputBox("符号:" & vbLf & "地址:0304" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
' Call 写入数据("0304", strInputData, "3")
' Case 17
' strInputData = InputBox("符号:" & vbLf & "地址:0308" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
' Call 写入数据("0308", strInputData, data2(1))
' Case 18
' strInputData = InputBox("符号:" & vbLf & "地址:030C" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
' Call 写入数据("030C", strInputData, data2(1))
' Case 19
' strInputData = InputBox("符号:" & vbLf & "地址:0310" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
' Call 写入数据("0310", strInputData, "0")
' Case 20
' strInputData = InputBox("符号:" & vbLf & "地址:0314" & vbLf & "说明:" & vbLf & "量程:", "参数修改")
' Call 写入数据("0314", strInputData, "0")
End Select
End Sub
Private Function 读取数据(Adress As String) As String
ReDim bytSend(7)
bytSend(0) = 1 '仪表地址
bytSend(1) = 3 '读取命令
Adress = Right("0000" & Adress, 4)
bytSend(2) = "&H" & Left(Adress, 2) '地址高位
bytSend(3) = "&H" & Right(Adress, 2) '地址低位
bytSend(4) = 0
bytSend(5) = 2
lngSendCrc16 = &HFFFF&
For intN = 0 To 5
lngSendCrc16 = Crc_16(CLng(bytSend(intN)), &HA001&, lngSendCrc16)
Next intN
bytSend(6) = CByte(lngSendCrc16 And &HFF&) '校验的高位
bytSend(7) = CByte(Fix(lngSendCrc16 / 256) And &HFF&) '校验的低位
MSComm1.Output = bytSend
Sleep 100
ReDim bytReceive(8)
Dim 小数系数 As Double
Dim 小数格式 As String
bytReceive = MSComm1.Input
If UBound(bytReceive) = 8 Then
lngReceiveCrc16 = &HFFFF& '接收数据的Crc_16校验
For intN = 0 To (UBound(bytReceive) - 2)
lngReceiveCrc16 = Crc_16(CLng(bytReceive(intN)), &HA001&, lngReceiveCrc16)
Next intN
bytCrcH = CByte(lngReceiveCrc16 And &HFF&) '校验的高位
bytCrcL = CByte(Fix(lngReceiveCrc16 / 256) And &HFF&) '校验的低位
If bytCrcL = bytReceive(UBound(bytReceive) - 1) And bytCrcH = bytReceive(UBound(bytReceive)) Then '判断接收数据的Crc_16校验的正确性
小数系数 = 10 ^ (-1 * bytReceive(6))
Select Case bytReceive(6)
Case 0
小数格式 = "0"
Case 1
小数格式 = "0.0"
Case 2
小数格式 = "0.00"
Case 3
小数格式 = "0.000"
End Select
If bytReceive(3) >= 128 Then
读取数据 = Format(((bytReceive(3) - 128) * 256 + bytReceive(4) - 32768) * 小数系数, 小数格式)
Else
读取数据 = Format((bytReceive(3) * 256 + bytReceive(4)) * 小数系数, 小数格式)
End If
End If
End If
End Function
Private Sub 写入数据(Adress As String, NewData As String, Dot As String)
If NewData <> "" Then
ReDim bytSend(12)
bytSend(0) = 1 '仪表地址
bytSend(1) = 16 '写入命令
Adress = Right("0000" & Adress, 4)
bytSend(2) = "&H" & Left(Adress, 2) '地址高位
bytSend(3) = "&H" & Right(Adress, 2) '地址低位
bytSend(4) = 0
bytSend(5) = 2
bytSend(6) = 4
If bytSend(2) = 2 And bytSend(3) = 4 Then
Else
NewData = NewData * (10 ^ Dot)
End If
If NewData < 0 Then
bytSend(7) = CLng("&H" & Left(Right("0000" & Hex(65536 + NewData), 4), 2)) '数值高位
bytSend(8) = CLng("&H" & Right(Right("0000" & Hex(65536 + NewData), 4), 2)) '数值低位
Else
bytSend(7) = CLng("&H" & Left(Right("0000" & Hex(NewData), 4), 2)) '数值高位
bytSend(8) = CLng("&H" & Right(Right("0000" & Hex(NewData), 4), 2)) '数值低位
End If
bytSend(9) = 0 '小数高位
bytSend(10) = Dot '小数低位
lngSendCrc16 = &HFFFF&
For intN = 0 To 10
lngSendCrc16 = Crc_16(CLng(bytSend(intN)), &HA001&, lngSendCrc16)
Next intN
bytSend(11) = CByte(lngSendCrc16 And &HFF&) '校验高位
bytSend(12) = CByte(Fix(lngSendCrc16 / 256) And &HFF&) '校验低位
MSComm1.Output = bytSend
Sleep 100
ReDim bytReceive(8)
bytReceive = MSComm1.Input
End If
End Sub
''Crc_16校验函数
'Private Function Crc_16(ByVal Data As Long, ByVal Genpoly As Long, ByVal CrcData As Long) As Long
' Dim TmpI As Integer
' Data = Data * 2
' For TmpI = 8 To 1 Step -1
' Data = Fix(Data / 2)
' If ((Data Xor CrcData) And 1) Then
' CrcData = Fix(CrcData / 2) Xor Genpoly
' Else
' CrcData = Fix(CrcData / 2)
' End If
' Next TmpI
' Crc_16 = CrcData
'End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -