?? 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 + -