📄 pc&plc.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form PLCForm
Caption = "PC机与PLC串口通信"
ClientHeight = 2985
ClientLeft = 60
ClientTop = 450
ClientWidth = 5655
LinkTopic = "Form1"
ScaleHeight = 2985
ScaleWidth = 5655
StartUpPosition = 3 '窗口缺省
Begin VB.Timer Timer1
Interval = 300
Left = 210
Top = 2415
End
Begin VB.Frame Frame1
Caption = "开关量输入"
Height = 2040
Left = 105
TabIndex = 6
Top = 105
Width = 2295
Begin VB.ComboBox ListInAddr
Height = 300
Left = 960
TabIndex = 7
Text = "Combo1"
Top = 480
Width = 1125
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "地址："
ForeColor = &H00000000&
Height = 180
Index = 3
Left = 180
TabIndex = 9
Top = 540
Width = 540
End
Begin VB.Shape InAlarm
BackColor = &H00C0FFC0&
BackStyle = 1 'Opaque
FillColor = &H00C0FFC0&
FillStyle = 0 'Solid
Height = 615
Left = 1050
Shape = 3 'Circle
Top = 1050
Width = 855
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "状态："
ForeColor = &H00000000&
Height = 180
Index = 2
Left = 210
TabIndex = 8
Top = 1260
Width = 540
End
End
Begin MSCommLib.MSComm MSComm1
Left = 4830
Top = 2310
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin VB.Frame Frame2
Caption = "开关量输出"
Height = 2040
Left = 2415
TabIndex = 2
Top = 105
Width = 3135
Begin VB.CommandButton Cmdset
Caption = "置位"
Height = 585
Left = 2205
TabIndex = 11
Top = 315
Width = 720
End
Begin VB.CommandButton Cmdreset
Caption = "复位"
Height = 585
Left = 2205
TabIndex = 10
Top = 1155
Width = 720
End
Begin VB.ComboBox ListOutAddr
Height = 300
Left = 960
TabIndex = 5
Text = "Combo2"
Top = 480
Width = 1125
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "状态："
ForeColor = &H00000000&
Height = 180
Index = 0
Left = 210
TabIndex = 4
Top = 1260
Width = 540
End
Begin VB.Shape OutAlarm
BackColor = &H00C0FFC0&
BackStyle = 1 'Opaque
FillColor = &H00C0FFC0&
FillStyle = 0 'Solid
Height = 615
Left = 1050
Shape = 3 'Circle
Top = 1050
Width = 855
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "地址："
ForeColor = &H00000000&
Height = 180
Index = 1
Left = 180
TabIndex = 3
Top = 540
Width = 540
End
End
Begin VB.CommandButton Cmdquit
Caption = "退 出"
Height = 375
Left = 3360
TabIndex = 1
Top = 2415
Width = 1245
End
Begin VB.CommandButton Cmdtest
Caption = "回路测试"
Height = 375
Left = 945
TabIndex = 0
Top = 2415
Width = 1245
End
End
Attribute VB_Name = "PLCForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'定义变量
Dim setadOut As String, DevDatOut As String
'程序初始化
Private Sub Form_Load()
'列出PLC端口输入输出全部地址
For g = 0 To 7
ListInAddr.AddItem g
ListOutAddr.AddItem g
Next g
For h = 10 To 17
ListInAddr.AddItem h
ListOutAddr.AddItem h
Next h
ListInAddr.ListIndex = 0
ListOutAddr.ListIndex = 0
MSComm1.CommPort = 1 '通信口
MSComm1.Settings = "9600,E,7,1" '串口参数设置
MSComm1.Handshaking = 0 '握手信号
MSComm1.InputLen = 0 '设置和返回input每次读出的字节数,设为0时读出接收缓冲区中的内容
MSComm1.OutBufferCount = 0 '设置和返回发送缓冲区的字节数,设为0时清空发送缓冲区
MSComm1.InBufferCount = 0 '设置和返回接收缓冲区的字节数,设为0时清空接收缓冲区
MSComm1.PortOpen = True '打开串口
InAlarm.FillColor = QBColor(10) '输入信号指示灯，初始绿色
OutAlarm.FillColor = QBColor(10) '输出信号指示灯，初始绿色
End Sub
'回路测试
Private Sub cmdtest_Click()
Dim Tim As Single
MSComm1.InBufferCount = 0 '清空接收缓冲区
MSComm1.OutBufferCount = 0 '清空发送缓冲区
MSComm1.Output = Chr(5)
Tim = Timer '返回一个 Single，代表从午夜开始到现在经过的秒数
Do
If Timer > Tim + 1 Then MsgBox "与PLC没有连接！": Exit Sub
Loop Until MSComm1.InBufferCount = 1
If Left$(MSComm1.Input, 1) = Chr(6) Then
MsgBox "与PLC通讯正常！", , "与PLC通讯检测"
Else
MsgBox "与PLC通讯不正常！", 48, "与PLC通讯检测"
End If
End Sub
'置位：置指定地址端口为ON，即打开指示灯
Private Sub Cmdset_Click()
Call diziq
If CStr(Val(setadOut)) <> setadOut Then Exit Sub '数字区包括了字母
MSComm1.OutBufferCount = 0
MSComm1.InBufferCount = 0
DevDatOut = "7" + DevDatOut
FG:
MSComm1.Output = Chr(2) + DevDatOut + SumChk(DevDatOut)
Tim = Timer
Do
If Timer > Tim + 1 Then: Exit Do
Loop Until MSComm1.InBufferCount = 1
If MSComm1.Input = Chr(6) Then
MSComm1.InBufferCount = 0
Else
If MsgBox("置位不成功", vbRetryCancel + vbCritical) = vbCancel Then Exit Sub
If MsgBox("置位不成功", vbRetryCancel + vbCritical) = vbRetry Then GoTo FG
End If
OutAlarm.FillColor = QBColor(12)
End Sub
'复位：置指定地址端口为OFF，即关闭指示灯
Private Sub Cmdreset_Click()
Call diziq
If CStr(Val(setadOut)) <> setadOut Then Exit Sub '数字区包括了字母
MSComm1.OutBufferCount = 0
MSComm1.InBufferCount = 0
DevDatOut = "8" + DevDatOut
FG:
MSComm1.Output = Chr(2) + DevDatOut + SumChk(DevDatOut)
Tim = Timer
Do
If Timer > Tim + 1 Then: Exit Do
Loop Until MSComm1.InBufferCount = 1
If MSComm1.Input = Chr(6) Then
MSComm1.InBufferCount = 0
Else
If MsgBox("复位不成功", vbRetryCancel + vbCritical) = vbCancel Then Exit Sub
If MsgBox("复位不成功", vbRetryCancel + vbCritical) = vbRetry Then GoTo FG
End If
OutAlarm.FillColor = QBColor(10)
End Sub
'周期检测输出端口状态
Private Sub Timer1_Timer()
Call In_for
End Sub
Private Sub In_for()
Dim awe, awe1, weishu
Dim BN8, BN7, BN6, BN5, BN4, BN3, BN2, BN1 As Integer
Dim devadd As String, setin As String, setad As String
Dim weishu1 As String, setad1 As String
setad = ListInAddr
If CStr(Val(setad)) <> setad Then Exit Sub '数字区包括了字母
If (setad Mod 10) < 4 Then '断定是低四位还是高四位
weishu = 0
Else
weishu = 1
End If
awe1 = setad Mod 10
If Oct(Val("&o" + setad)) <> setad Then '判断是不是八进制。
Exit Sub
End If
setad1 = Val(Str(setad \ 10))
devadd = "0" + "008" + Hex("&o" + setad1) + "02" + Chr(3)
MSComm1.InBufferCount = 0
MSComm1.OutBufferCount = 0
MSComm1.Output = Chr(2) + devadd + SumChk(devadd)
Tim = Timer
Do
If Timer > Tim + 1 Then: Exit Do
Loop Until MSComm1.InBufferCount = 20
setin = MSComm1.Input
weishu1 = Val("&H" + Mid(setin, 2, 2))
awe = dec2bin(weishu1)
BN8 = Mid(awe, 1, 1)
BN7 = Mid(awe, 2, 1)
BN6 = Mid(awe, 3, 1)
BN5 = Mid(awe, 4, 1)
BN4 = Mid(awe, 5, 1)
BN3 = Mid(awe, 6, 1)
BN2 = Mid(awe, 7, 1)
BN1 = Mid(awe, 8, 1)
Select Case awe1
Case 0 'awe1断定元件号的位数，如是0位或4位
If BN1 = 1 Then
biaozi = True
Else
biaozi = False
End If
Case 1
If BN2 = 1 Then
biaozi = True
Else
biaozi = False
End If
Case 2
If BN3 = 1 Then
biaozi = True
Else
biaozi = False
End If
Case 3
If BN4 = 1 Then
biaozi = True
Else
biaozi = False
End If
Case 4 'awe1断定元件号的位数，如是0位或4位
If BN5 = 1 Then
biaozi = True
Else
biaozi = False
End If
Case 5
If BN6 = 1 Then
biaozi = True
Else
biaozi = False
End If
Case 6
If BN7 = 1 Then
biaozi = True
Else
biaozi = False
End If
Case 7
If BN8 = 1 Then
biaozi = True
Else
biaozi = False
End If
End Select
If biaozi = True Then
InAlarm.FillColor = QBColor(12)
Else
InAlarm.FillColor = QBColor(10)
End If
End Sub
'转换成二进制
Private Function dec2bin(Dats$) As String
Dim bin8, bin4, bin2, bin1, bin16, bin32, bin64, bin128
If Dats \ 128 >= 1 Then
bin128 = 1
Else
bin128 = 0
End If
If (Dats Mod 128) \ 64 >= 1 Then
bin64 = 1
Else
bin64 = 0
End If
If (Dats Mod 64) \ 32 >= 1 Then 'Mod用来对两个数作除法并且只返回余数
bin32 = 1
Else
bin32 = 0
End If
If (Dats Mod 32) \ 16 >= 1 Then
bin16 = 1
Else
bin16 = 0
End If
If (Dats Mod 16) \ 8 >= 1 Then '\ 运算符用来对两个数作除法并返回一个整数
bin8 = 1
Else
bin8 = 0
End If
If (Dats Mod 8) \ 4 >= 1 Then 'Mod用来对两个数作除法并且只返回余数
bin4 = 1
Else
bin4 = 0
End If
If (Dats Mod 4) \ 2 >= 1 Then
bin2 = 1
Else
bin2 = 0
End If
If Dats Mod 2 = 0 Then
bin1 = 0
Else
bin1 = 1
End If
bin128 = CStr(bin128) 'CStr 函数将一数值转换为 String
bin64 = CStr(bin64)
bin32 = CStr(bin32)
bin16 = CStr(bin16)
bin8 = CStr(bin8) 'CStr 函数将一数值转换为 String
bin4 = CStr(bin4)
bin2 = CStr(bin2)
bin1 = CStr(bin1)
dec2bin = bin128 + bin64 + bin32 + bin16 + bin8 + bin4 + bin2 + bin1
End Function
'地址计算
Public Sub diziq()
Dim setaddr As String
setadOut = ListInAddr.Text
If setadOut = "" Then
MsgBox ("请输入元件地址！")
Exit Sub
End If
If CStr(Val(setadOut)) <> setadOut Then Exit Sub '数字区包括了字母
If Oct(Val("&o" + setadOut)) <> setadOut Then '判断是不是八进制。
Exit Sub
End If
DevDatOut = ydizi(setadOut)
End Sub
'地址范围是0500__057F,方式是1032
Private Function ydizi(Dats$) As String
Dim devadd As String
Dim station1
devadd = Hex("&o" + setadOut)
station1 = "00" + devadd
devadd = Right(station1, 2)
ydizi = devadd + "05" + Chr(3) 'Y的地址
End Function
Private Function SumChk(Dats$) As String
Dim I&
Dim CHK&
For I = 1 To Len(Dats)
CHK = CHK + Asc(Mid(Dats, I, 1))
Next I
SumChk = Right(Hex$(CHK), 2)
End Function
'关闭串口退出程序
Private Sub cmdquit_Click()
Set PLCForm = Nothing
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
End
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set PLCForm = Nothing
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
End
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -