📄 form2.frm
字号:
BackStyle = 0 'Transparent
Caption = "红为运行蓝为监控编程为黑"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 735
Left = 4560
TabIndex = 27
Top = 360
Width = 1215
End
Begin VB.Line Line5
BorderColor = &H00C0C0C0&
X1 = 4320
X2 = 4320
Y1 = 1320
Y2 = 120
End
Begin VB.Line Line4
BorderColor = &H00C0C0C0&
X1 = 5520
X2 = 4320
Y1 = 1320
Y2 = 1320
End
Begin VB.Line Line1
BorderColor = &H00C0C0C0&
X1 = 5520
X2 = 5520
Y1 = 1320
Y2 = 2520
End
Begin VB.Shape Shape3
BorderColor = &H00FF0000&
FillColor = &H0080FFFF&
FillStyle = 0 'Solid
Height = 855
Left = 2520
Shape = 3 'Circle
Top = 480
Width = 975
End
Begin VB.Label 正常
BackStyle = 0 'Transparent
Caption = "通讯正常为绿"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 255
Left = 360
TabIndex = 20
Top = 360
Width = 1335
End
Begin VB.Shape Shape1
BackColor = &H00E0E0E0&
BorderColor = &H00FF0000&
FillColor = &H0080FFFF&
FillStyle = 0 'Solid
Height = 855
Left = 600
Shape = 3 'Circle
Top = 840
Width = 855
End
Begin VB.Line Line2
BorderColor = &H00C0C0C0&
X1 = 1920
X2 = 1920
Y1 = 120
Y2 = 2520
End
Begin VB.Shape Shape2
BorderColor = &H00FF0000&
FillColor = &H0080FFFF&
FillStyle = 0 'Solid
Height = 855
Left = 6120
Shape = 3 'Circle
Top = 240
Width = 855
End
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public Function fcs(ByVal inputstr As String) As String
Dim slen, i, xorresult As Integer
Dim tempfcs As String
slen = Len(inputstr)
xorresult = 0
For i = 1 To slen
xorresult = xorresult Xor Asc(Mid$(inputstr, i, 1))
Next i
tempfcs = Hex$(xorresult)
If Len(tempfcs) = 1 Then tempfcs = "0" + tempfcs
fcs = tempfcs
End Function
' 用途：将十六进制转化为二 进 制
' 输入：Hex(十六进制数)
' 输入数据类型：String
' 输出：HEX_to_BIN(二 进 制数)
' 输出数据类型：String
' 输入的最大数为2147483647个字符
Public Function HEX_to_BIN(ByVal Hex As String) As String
Dim i As Long
Dim B As String
Hex = UCase(Hex)
For i = 1 To Len(Hex)
Select Case Mid(Hex, i, 1)
Case "0": B = B & "0000"
Case "1": B = B & "0001"
Case "2": B = B & "0010"
Case "3": B = B & "0011"
Case "4": B = B & "0100"
Case "5": B = B & "0101"
Case "6": B = B & "0110"
Case "7": B = B & "0111"
Case "8": B = B & "1000"
Case "9": B = B & "1001"
Case "A": B = B & "1010"
Case "B": B = B & "1011"
Case "C": B = B & "1100"
Case "D": B = B & "1101"
Case "E": B = B & "1110"
Case "F": B = B & "1111"
End Select
Next i
HEX_to_BIN = B
End Function
Private Sub Cmd10_Click()
Form6.Show
Form2.Enabled = False
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub Cmd11_Click()
Form7.Show
Form2.Enabled = False
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub Cmd12_Click()
Form4.Show
Form2.Enabled = False
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub Cmd13_Click()
Form8.Show
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
Form2.Enabled = False
End Sub
Private Sub Cmd14_Click()
Form2.Enabled = False
Form9.Show
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub Cmd15_Click()
Form2.Enabled = False
Form10.Show
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub CMD2_Click()
Form15.Show
Form2.Enabled = False
MSComm1.PortOpen = False
End Sub
Private Sub Cmd4_Click()
Dim A As String
Dim B As String
Dim X As String
Dim C As String
Dim D As String
Dim e As String
Dim F As String
MSComm1.InBufferCount = 0
MSComm1.InputLen = 0
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
A = "@00MS" + fcs("@00MS") + "*" + Chr$(13)
MSComm1.Output = A
Do
DoEvents
Loop Until MSComm1.InBufferCount >= 14
B = MSComm1.Input
C = Mid((B), 6, 2)
If C = "00" Then
Else
X = MsgBox("读PLC状态不成功", 25): Shape2.FillColor = vbYellow
End If
D = Mid((B), 8, 2)
e = HEX_to_BIN(Mid((B), 8, 2))
F = Mid((e), 7, 2)
Select Case F
Case "00"
Shape2.FillColor = vbBlack
X = MsgBox("编程状态", 25)
Case "10"
Shape2.FillColor = vbRed
X = MsgBox("运行状态", 25)
Case "11"
Shape2.FillColor = vbBlue
X = MsgBox("监控状态", 25)
Case Else
X = MsgBox("读取状态不成功", 25)
End Select
Shape2.FillColor = vbYellow
End Sub
Private Sub Cmd5_Click()
Dim A As String
Dim B As String
Dim X As String
Dim C As String
MSComm1.InBufferCount = 0
MSComm1.InputLen = 0
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
A = "@00SC00" + fcs("@00SC00") + "*" + Chr$(13)
MSComm1.Output = A
Do
DoEvents
Loop Until MSComm1.InBufferCount >= 8
B = MSComm1.Input
C = "@00SC00" + fcs("@00SC00") + "*" + Chr$(13)
If B <> C Then
X = MsgBox("置编程状态不成功", 25)
Else: Shape2.FillColor = vbBlack
X = MsgBox("置编程状态成功", 25)
End If
Shape2.FillColor = vbYellow
End Sub
Private Sub Cmd6_Click()
Dim A As String
Dim B As String
Dim X As String
Dim C As String
MSComm1.InBufferCount = 0
MSComm1.InputLen = 0
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
A = "@00SC02" + fcs("@00SC02") + "*" + Chr$(13)
MSComm1.Output = A
Do
DoEvents
Loop Until MSComm1.InBufferCount >= 8
B = MSComm1.Input
C = "@00SC00" + fcs("@00SC00") + "*" + Chr$(13)
If B <> C Then
X = MsgBox("置监控状态不成功", 25)
Else: Shape2.FillColor = vbBlue
X = MsgBox("置监控状态成功", 25)
End If
Shape2.FillColor = vbYellow
End Sub
Private Sub Cmd7_Click()
Dim A As String
Dim B As String
Dim X As String
Dim C As String
MSComm1.InBufferCount = 0
MSComm1.InputLen = 0
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
A = "@00SC03" + fcs("@00SC03") + "*" + Chr$(13)
MSComm1.Output = A
Do
DoEvents
Loop Until MSComm1.InBufferCount >= 8
B = MSComm1.Input
C = "@00SC00" + fcs("@00SC00") + "*" + Chr$(13)
If B <> C Then
X = MsgBox("置运行状态不成功", 25)
Else: Shape2.FillColor = vbRed
X = MsgBox("置运行状态成功", 25)
End If
Shape2.FillColor = vbYellow
End Sub
Private Sub Cmd8_Click()
Form3.Show
Form2.Enabled = False
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub Cmd9_Click()
Form2.Enabled = False
Form5.Show
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub Command1_Click()
Form11.Show
Form2.Enabled = False
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub Command2_Click()
Form12.Show
Form2.Enabled = False
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub Command3_Click()
Form13.Show
Form2.Enabled = False
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub Command4_Click()
Form14.Show
Form2.Enabled = False
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub Command5_Click()
Dim A As String
Dim B As String
Dim C As String
Dim X As String
MSComm1.InBufferCount = 0
MSComm1.InputLen = 0
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
A = "@00KC" + fcs("@00KC") + "*" + Chr$(13)
MSComm1.Output = A
Do
DoEvents
Loop Until MSComm1.InBufferCount >= 8
B = MSComm1.Input
C = Mid((B), 6, 2)
If C = "00" Then
Shape3.FillColor = vbBlue: X = MsgBox("取消置位正常", 30)
Else: Shape3.FillColor = vbRed: X = MsgBox("取消置位不正常", 30)
End If
Shape3.FillColor = vbYellow
End Sub
Private Sub Form_Load()
Rem 初始化
MSComm1.CommPort = 3
MSComm1.Settings = "9600,E,7,2"
MSComm1.InputLen = 0
MSComm1.PortOpen = True
End Sub
Private Sub Cmd1_Click()
Dim X As String
Dim A As String
Dim B As String
Dim i As Integer
Dim tp As String
Rem 回路测试程序
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
MSComm1.InBufferCount = 0
MSComm1.InputLen = 0
A = "@00TS00123" + fcs("@00TS00123") + "*" + Chr$(13)
MSComm1.Output = A
Do
DoEvents
Loop Until MSComm1.InBufferCount >= 11
B = MSComm1.Input
If A = B Then
Shape1.FillColor = vbBlue: X = MsgBox("通讯正常", 30)
Else: Shape1.FillColor = vbRed: X = MsgBox("通讯不正常", 30)
End If
Shape1.FillColor = vbYellow
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -