📄 opc.frm
字号:
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 84
Top = 2040
Width = 855
End
End
Begin VB.Frame Frame2
Caption = "OPC项目"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 4335
Left = 0
TabIndex = 27
Top = 2880
Width = 10215
Begin VB.CommandButton OPCRemoveItems
Caption = "删除OPC项目"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 6360
TabIndex = 82
ToolTipText = "点击此处从OPC组中删除所有项"
Top = 120
Width = 1815
End
Begin VB.CheckBox OPCItemActiveState
Alignment = 1 'Right Justify
Caption = "已激活"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 7560
TabIndex = 63
ToolTipText = "点击此处改变OPC项的激活状态"
Top = 720
Value = 1 'Checked
Width = 855
End
Begin VB.CommandButton OPCItemWriteButton
Caption = "写入数据"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 6360
TabIndex = 62
ToolTipText = "点击此处将“写入值”中的数据同步写入服务器"
Top = 720
Width = 975
End
Begin VB.TextBox OPCItemValueToWrite
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 0
Left = 4560
TabIndex = 51
ToolTipText = "在此处填入要写入的数据，然后点击“写入数据”按钮"
Top = 720
Width = 1455
End
Begin VB.TextBox OPCItemQuality
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 0
Left = 8880
Locked = -1 'True
TabIndex = 40
Top = 720
Width = 855
End
Begin VB.TextBox OPCItemValue
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 0
Left = 3000
Locked = -1 'True
TabIndex = 29
Top = 720
Width = 1455
End
Begin VB.Label Label9
Alignment = 2 'Center
Caption = "写入值"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 4800
TabIndex = 61
Top = 480
Width = 1215
End
Begin VB.Label Label8
Alignment = 2 'Center
Caption = "品质"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 8880
TabIndex = 50
Top = 480
Width = 855
End
Begin VB.Label Label7
Alignment = 2 'Center
Caption = "当前值"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3000
TabIndex = 39
Top = 480
Width = 1335
End
Begin VB.Label Label4
Alignment = 2 'Center
Caption = "OPC项目名"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 600
TabIndex = 28
Top = 480
Width = 1815
End
End
Begin VB.Label Label10
Caption = "ATCE Department."
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 0
TabIndex = 87
Top = 0
Width = 1695
End
Begin VB.Label Label2
Caption = "ABB Shaghai Co.,Ltd"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 1
Left = 0
TabIndex = 85
Top = 0
Width = 1935
End
End
Attribute VB_Name = "SimpleOPCInterface"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' OPCDA客户端程序
Option Explicit
Option Base 1
' 数据库处理
Dim db As Database
Dim strDBName As String ' 数据库存储路径
Dim ItemNameDot(10) As String ' 用以存储替换数据表命名不允许出现的字符
Dim ItemForDB(10) As Variant
Dim dbTable(10) As TableDef
Dim rs(10) As Recordset
Dim TimeCount As Integer
' 用WithEvents声明对象生成的变量
Dim WithEvents AnOPCServer As OPCServer
Attribute AnOPCServer.VB_VarHelpID = -1
Dim WithEvents ConnectedOPCServer As OPCServer
Attribute ConnectedOPCServer.VB_VarHelpID = -1
Dim ConnectedServerGroup As OPCGroups
Dim WithEvents ConnectedGroup As OPCGroup
Attribute ConnectedGroup.VB_VarHelpID = -1
Dim OPCItemCollection As OPCItems
Dim ItemCount As Long
Dim ItemAddNum As Integer
Dim OPCItemIDs(10) As String
Dim ItemServerHandles() As Long
Dim ItemServerErrors() As Long
Dim ClientHandles(10) As Long
Private Sub dbCreate_Click()
Call DBevents
End Sub
Private Sub DBFilter_Click()
If DBFilterList.ListIndex = 0 Then
Call Filter2
Else
If DBFilterList.ListIndex = 1 Then
Call Filter3
Else
Call Filter4
End If
End If
End Sub
Private Sub dbStop_Click()
Dim i As Integer
Timer1.Enabled = False
End Sub
Private Sub Form_Load()
AvailableOPCServerList.AddItem "点击'OPC服务器列表'开始"
End Sub
'程序结束时调用
Private Sub Form_Terminate()
Call ExitExample_Click
End Sub
Private Sub ListOPCServers_Click()
Dim AllOPCServers As Variant
Dim i As Integer
On Error GoTo ShowOPCGetServersError
'建立临时的OPCServer用来取得服务器列表
Set AnOPCServer = New OPCServer
AvailableOPCServerList.Clear
AllOPCServers = AnOPCServer.GetOPCServers
For i = LBound(AllOPCServers) To UBound(AllOPCServers)
AvailableOPCServerList.AddItem AllOPCServers(i)
Next i
GoTo SkipOPCGetServersError
ShowOPCGetServersError:
Call DisplayOPC_COM_ErrorValue("取得OPC服务器列表", Err.Number)
SkipOPCGetServersError:
Set AnOPCServer = Nothing
End Sub
Private Sub AvailableOPCServerList_Click()
' 点击列表中项目时取得OPC服务器名称
OPCServerName = AvailableOPCServerList.List(AvailableOPCServerList.ListIndex)
End Sub
Private Sub OPCServerConnect_Click()
Dim ConnectedServerName As String
Dim ConnectedNodeName As Variant
If InStr(OPCServerName.Text, "点击") = 0 Then
On Error GoTo ShowOPCConnectError
Set ConnectedOPCServer = New OPCServer
ConnectedServerName = OPCServerName.Text
'如果是本地主机可留空，远程主机必须填入主机所在网络节点或IP
ConnectedNodeName = OPCNodeName.Text
ConnectedOPCServer.Connect ConnectedServerName, ConnectedNodeName
DisconnectFromServer.Enabled = True
OPCServerConnect.Enabled = False
AvailableOPCServerList.Enabled = False
OPCServerName.Enabled = False
' 开启组操作栏
OPCGroupName.Enabled = True
GroupUpdateRate.Enabled = True
GroupDeadBand.Enabled = True
GroupActiveState.Enabled = True
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -