📄 form1.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
Caption = "PLC编程口通讯测试"
ClientHeight = 5565
ClientLeft = 4770
ClientTop = 4410
ClientWidth = 8760
Icon = "Form1.frx":0000
LinkTopic = "Form1"
ScaleHeight = 5565
ScaleWidth = 8760
Begin VB.TextBox Text6
ForeColor = &H00C00000&
Height = 5415
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 18
ToolTipText = "收发记录"
Top = 0
Width = 4215
End
Begin VB.Frame Frame2
Caption = "请选择元件地址(X，Y，M，S，C，T)"
Height = 2535
Left = 4500
TabIndex = 12
Top = 2940
Width = 4155
Begin VB.CommandButton Command6
Caption = "清空记录"
Height = 375
Left = 2580
TabIndex = 23
Top = 1920
Width = 1095
End
Begin VB.CommandButton Command5
Caption = "查询"
Height = 375
Left = 1560
TabIndex = 17
Top = 1140
Width = 795
End
Begin VB.CommandButton Command4
Caption = "复位"
Height = 375
Left = 2940
TabIndex = 16
Top = 1140
Width = 735
End
Begin VB.CommandButton Command3
Caption = "置位"
Height = 375
Left = 2940
TabIndex = 15
Top = 360
Width = 735
End
Begin VB.TextBox Text5
Height = 330
Left = 1740
TabIndex = 14
Top = 420
Width = 855
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "Form1.frx":628A
Left = 480
List = "Form1.frx":6297
TabIndex = 13
Text = "M"
Top = 420
Width = 855
End
Begin VB.Shape Shape1
FillColor = &H00FFFFFF&
FillStyle = 0 'Solid
Height = 255
Left = 540
Shape = 3 'Circle
Top = 1200
Width = 255
End
End
Begin VB.Frame Frame1
Height = 2835
Left = 4500
TabIndex = 0
Top = 0
Width = 4095
Begin VB.Frame Frame3
Caption = "寄存器位数"
Height = 615
Left = 300
TabIndex = 20
Top = 240
Width = 3375
Begin VB.OptionButton Option1
Caption = "16位"
Height = 255
Left = 240
TabIndex = 22
Top = 240
Value = -1 'True
Width = 675
End
Begin VB.OptionButton Option2
Caption = "32位"
Height = 255
Left = 1920
TabIndex = 21
Top = 240
Width = 675
End
End
Begin VB.TextBox Text4
Height = 330
Left = 1740
TabIndex = 10
Top = 2280
Width = 855
End
Begin VB.TextBox Text3
Height = 330
Left = 420
TabIndex = 9
Top = 2280
Width = 855
End
Begin VB.CommandButton Command2
Caption = "写入"
Height = 375
Left = 2880
TabIndex = 7
Top = 2280
Width = 735
End
Begin VB.CommandButton Command1
Caption = "读取"
Height = 375
Left = 2880
TabIndex = 6
Top = 1320
Width = 735
End
Begin VB.TextBox Text2
Height = 330
Left = 1740
TabIndex = 4
Top = 1380
Width = 855
End
Begin VB.TextBox Text1
Height = 330
Left = 420
TabIndex = 3
Top = 1380
Width = 855
End
Begin VB.Label Label5
Caption = "寄存器数值"
Height = 255
Left = 1680
TabIndex = 19
Top = 1920
Width = 975
End
Begin VB.Label Label6
Caption = "D"
Height = 195
Left = 240
TabIndex = 11
Top = 2340
Width = 135
End
Begin VB.Label Label4
Caption = "寄存器地址"
Height = 255
Left = 300
TabIndex = 8
Top = 1920
Width = 1035
End
Begin VB.Label Label3
Caption = "D"
Height = 195
Left = 240
TabIndex = 5
Top = 1440
Width = 135
End
Begin VB.Label Label2
Caption = "寄存器数值"
Height = 255
Left = 1620
TabIndex = 2
Top = 1020
Width = 975
End
Begin VB.Label Label1
Caption = "寄存器地址"
Height = 255
Left = 300
TabIndex = 1
Top = 1020
Width = 1035
End
End
Begin VB.Timer Timer2
Interval = 1000
Left = 1980
Top = 1980
End
Begin MSCommLib.MSComm MSComm1
Left = 3360
Top = 240
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
NullDiscard = -1 'True
RTSEnable = -1 'True
ParitySetting = 2
DataBits = 7
EOFEnable = -1 'True
InputMode = 1
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 Sub Command1_Click() '读取
Dim s As String
If Text1.Text = "" Then
MsgBox "请选怎元件! "
Exit Sub
End If
Text1.Text = Format$(Text1.Text, "0000")
s = "D" & Text1.Text
If Option1.value = True Then
Dread s, 2
Else
Dread s, 4
End If
End Sub
Private Sub Command2_Click() '写入
Dim Component As String
Dim str1 As String, j As Integer
If Text3.Text = "" Then
MsgBox "请选怎元件! "
Exit Sub
End If
Text3.Text = Format$(Text3.Text, "0###")
Component = "D" & Text3.Text
If Option1.value = True Then '16进制16位
str1 = Trim(Text4.Text)
j = Len(str1)
If (4 - j) < 0 Then
MsgBox "数值过大！"
Exit Sub
End If
str1 = String(4 - j, "0") & str1
Text4.Text = str1
Dwrite Component, 2, str1
Else '32位
str1 = Trim(Text4.Text)
j = Len(str1)
If (8 - j) < 0 Then
MsgBox "数值过大！"
Exit Sub
End If
str1 = String(8 - j, "0") & str1
Text4.Text = str1
Dwrite Component, 4, str1
End If
End Sub
Private Sub Command3_Click() '置位
Dim s As String
If Text5.Text = "" Then
MsgBox "请选怎元件! "
Exit Sub
End If
Text5.Text = Format(Text5.Text, "0###")
s = Trim(Combo1.Text) & Text5.Text
Call BitForce(s, True)
End Sub
Private Sub Command4_Click() '复位
Dim s As String
If Text5.Text = "" Then
MsgBox "请选怎元件! "
Exit Sub
End If
Text5.Text = Format(Text5.Text, "0###")
s = Trim(Combo1.Text) & Text5.Text
Call BitForce(s, False)
End Sub
Private Sub Command5_Click() '查询
Dim s As String
If Text5.Text = "" Then
MsgBox "请选怎元件! "
Exit Sub
End If
Text5.Text = Format(Text5.Text, "0###")
s = Trim(Combo1.Text) & Text5.Text
Call BitSearch(s)
End Sub
Private Sub Command6_Click() '清空
Text6.Text = ""
End Sub
Private Sub Form_load()
On Error GoTo erhd
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
With MSComm1
.CommPort = 1
.Settings = "9600,E,7,1" '9600，偶校验，7位数据，1位停止位
.InputMode = comInputModeBinary '以二进制格式读取接收缓冲区
.RThreshold = 1 '接收的字符大于等于1产生接收事件
.InputLen = 0 '度处缓冲区的所有位
.OutBufferCount = 0 '清空发送缓冲区
.InBufferCount = 0 '清空接收缓冲区
.PortOpen = True
End With
Timer2.Interval = 1000
Timer2.Enabled = False '超时判度定时器
Num = 0
RcvFinFlag = True '接收完成标志初始化
Exit Sub
erhd:
MsgBox "无法打开端口!", vbOKOnly, "错误"
End
End Sub
Private Sub MSComm1_OnComm() '接收数据子程序
Dim RcvTemp() As Byte, i As Integer
Dim length As Integer
If RcvFinFlag = True Then Exit Sub
ReDim Preserve RcvData(100) As Byte
If Form1.MSComm1.CommEvent = comEventFrame Then
MsgBox "双方通信格式设置不同", "提示"
Timer2.Enabled = False
Exit Sub
End If
'-----------------------------------------------------------------------------------------
If Form1.MSComm1.CommEvent = comEvReceive Then
RcvTemp = Form1.MSComm1.Input '接收缓冲区的数据送入暂存数组
For i = LBound(RcvTemp) To UBound(RcvTemp)
RcvLen = RcvLen + 1 'RcvLen的初始值为-1
If RcvLen > 100 Then
RcvLen = -1
Call ErrorHandle
Exit Sub
End If
RcvData(RcvLen) = RcvTemp(i)
Next i
ReDim Preserve RcvData(RcvLen) As Byte
' Call InTxt(RcvData) '显示
'------------------------------------------------------------------------------------------
Select Case Flag
Case 0 'Dread
For i = LBound(RcvData) To UBound(RcvData)
If RcvData(i) = &H3 And UBound(RcvData) = i + 2 Then
length = UBound(RcvData)
ReDim Preserve RcvData(length) As Byte
RcvFinFlag = True
RcvLen = -1
Form1.Timer2.Enabled = False '关闭通信超时定时器
Call InTxt(RcvData) '显示
If RcvDataChk(RcvData) Then '接收数据检查子程序
Text2.Text = RcvDataDisplay(RcvData) '数据显示
Num = 0 '重发计数复位
Else
Call ErrorHandle
End If
Exit For
End If
Next i
Case 1, 7, 8 'DWrite ,Force On/Off
If RcvData(0) = &H6 Then
ReDim Preserve RcvData(0) As Byte
Timer2.Enabled = False 'PLC正确执行写命令关闭通信超时定时器
Num = 0 '复位重发计数器
RcvFinFlag = True
RcvLen = -1
Call InTxt(RcvData) '显示
Else
If RcvData(0) = &H15 Then
ReDim Preserve RcvData(0) As Byte
Timer2.Enabled = False
RcvFinFlag = True
RcvLen = -1
Call InTxt(RcvData) '显示
Call ErrorHandle
End If
End If
Case 9 '查询位元件
For i = LBound(RcvData) To UBound(RcvData)
If RcvData(i) = &H3 And UBound(RcvData) = i + 2 Then
length = UBound(RcvData)
ReDim Preserve RcvData(length) As Byte
RcvFinFlag = True
RcvLen = -1
Form1.Timer2.Enabled = False
Call InTxt(RcvData) '显示记录
If RcvDataChk(RcvData) Then
Call BitDisplay(RcvData) '显示查询结果
Num = 0
Else
Call ErrorHandle
End If
Exit For
End If
Next i
End Select
End If
End Sub
Private Sub Form_Resize()
If Form1.Width > 4300 And Form1.Height > 3600 Then
Text6.Move 0, 0, Form1.Width - 4300, Form1.Height - 600
Frame1.Move Text6.Width + 30, 0, 4095, 3000
Frame2.Move Frame1.Left, Frame1.Height + 20, 4095, Form1.Height - 3600
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
End Sub
Private Sub timer2_timer() '超时判断定时器
Call ErrorHandle
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -