📄 frmopc.frm
字号:
Left = 7320
TabIndex = 27
Top = 2640
Width = 1332
End
Begin VB.TextBox ItemName
Appearance = 0 'Flat
Height = 264
Index = 15
Left = 3960
TabIndex = 26
Top = 5760
Width = 3372
End
Begin VB.TextBox ItemName
Appearance = 0 'Flat
Height = 264
Index = 14
Left = 3960
TabIndex = 25
Top = 5520
Width = 3372
End
Begin VB.TextBox ItemName
Appearance = 0 'Flat
Height = 264
Index = 13
Left = 3960
TabIndex = 24
Top = 5280
Width = 3372
End
Begin VB.TextBox ItemName
Appearance = 0 'Flat
Height = 264
Index = 12
Left = 3960
TabIndex = 23
Top = 5040
Width = 3372
End
Begin VB.TextBox ItemName
Appearance = 0 'Flat
Height = 264
Index = 11
Left = 3960
TabIndex = 22
Top = 4800
Width = 3372
End
Begin VB.TextBox ItemName
Appearance = 0 'Flat
Height = 264
Index = 10
Left = 3960
TabIndex = 21
Top = 4560
Width = 3372
End
Begin VB.TextBox ItemName
Appearance = 0 'Flat
Height = 264
Index = 9
Left = 3960
TabIndex = 20
Top = 4320
Width = 3372
End
Begin VB.TextBox ItemName
Appearance = 0 'Flat
Height = 264
Index = 8
Left = 3960
TabIndex = 19
Top = 4080
Width = 3372
End
Begin VB.ComboBox ServerName
Height = 276
Left = 1680
TabIndex = 14
Top = 600
Width = 2715
End
Begin VB.TextBox UpdateRateSet
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 7080
TabIndex = 13
Text = "1000"
Top = 600
Width = 615
End
Begin VB.TextBox ItemName
Appearance = 0 'Flat
Height = 264
Index = 7
Left = 3960
TabIndex = 12
Top = 3840
Width = 3372
End
Begin VB.TextBox ItemName
Appearance = 0 'Flat
Height = 264
Index = 6
Left = 3960
TabIndex = 11
Top = 3600
Width = 3372
End
Begin VB.TextBox ItemName
Appearance = 0 'Flat
Height = 264
Index = 5
Left = 3960
TabIndex = 10
Top = 3360
Width = 3372
End
Begin VB.TextBox ItemName
Appearance = 0 'Flat
Height = 264
Index = 4
Left = 3960
TabIndex = 9
Top = 3120
Width = 3372
End
Begin VB.TextBox ItemName
Appearance = 0 'Flat
Height = 264
Index = 3
Left = 3960
TabIndex = 8
Top = 2880
Width = 3372
End
Begin VB.TextBox ItemName
Appearance = 0 'Flat
Height = 264
Index = 2
Left = 3960
TabIndex = 7
Top = 2640
Width = 3372
End
Begin VB.TextBox ItemName
Appearance = 0 'Flat
Height = 264
Index = 1
Left = 3960
TabIndex = 6
Top = 2400
Width = 3372
End
Begin VB.TextBox Value
Appearance = 0 'Flat
Height = 264
Index = 1
Left = 7320
TabIndex = 5
Top = 2400
Width = 1332
End
Begin VB.TextBox Quality
Appearance = 0 'Flat
Height = 264
Index = 0
Left = 10680
TabIndex = 4
Top = 2160
Width = 615
End
Begin VB.TextBox Time
Appearance = 0 'Flat
Height = 264
Index = 0
Left = 8640
TabIndex = 3
Top = 2160
Width = 2055
End
Begin VB.TextBox Value
Appearance = 0 'Flat
Height = 264
Index = 0
Left = 7320
TabIndex = 2
Top = 2160
Width = 1332
End
Begin VB.TextBox ItemName
Appearance = 0 'Flat
Height = 264
Index = 0
Left = 3960
TabIndex = 1
Top = 2160
Width = 3372
End
Begin VB.CommandButton CONNECT
Caption = "建立连接"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 8880
TabIndex = 0
Top = 600
Width = 1032
End
Begin VB.Frame Frame1
Caption = "系统设置"
Height = 852
Left = 120
TabIndex = 15
Top = 240
Width = 11532
Begin VB.Label Label5
Caption = "采样周期(ms)"
Height = 252
Index = 1
Left = 5760
TabIndex = 17
Top = 360
Width = 1212
End
Begin VB.Label Label5
Caption = "OPC服务器名"
Height = 252
Index = 0
Left = 240
TabIndex = 16
Top = 360
Width = 1092
End
End
Begin VB.Frame Frame2
Height = 6972
Left = 120
TabIndex = 18
Top = 1560
Width = 11532
Begin VB.Label Label6
Caption = "质量"
Height = 252
Index = 4
Left = 10680
TabIndex = 74
Top = 360
Width = 492
End
Begin VB.Label Label6
Caption = "时间戳"
Height = 252
Index = 3
Left = 9120
TabIndex = 73
Top = 360
Width = 612
End
Begin VB.Label Label6
Caption = "采样值"
Height = 252
Index = 2
Left = 7560
TabIndex = 72
Top = 360
Width = 612
End
Begin VB.Label Label6
Caption = "项目连接名"
Height = 252
Index = 1
Left = 4800
TabIndex = 71
Top = 360
Width = 1092
End
Begin VB.Label Label6
Caption = "项目名称"
Height = 252
Index = 0
Left = 1920
TabIndex = 70
Top = 360
Width = 972
End
End
End
Attribute VB_Name = "FrmOPC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Base 1
Option Explicit
Private Const ItemMax = 8
Dim WithEvents OPCMyserver As OPCServer
Attribute OPCMyserver.VB_VarHelpID = -1
Dim WithEvents OPCMygroups As OPCGroups
Attribute OPCMygroups.VB_VarHelpID = -1
Dim WithEvents OPCMygroup As OPCGroup
Attribute OPCMygroup.VB_VarHelpID = -1
Dim OPCMyitems As OPCItems
Dim OPCMyitem As OPCItem
Dim bConnect As Boolean
Private Sub itemload()
On Error GoTo LoadEnd
Dim ItemName As String
Dim ItemName1 As String
Dim i, Fno As Integer
'
Dim j As Integer
Dim Fno1 As Integer
Fno = 1
Open "OPCSample.INI" For Input As #Fno
i = 1
Do While Not EOF(Fno)
Input #Fno, ItemName
FrmOPC.ItemName(i - 1).Text = ItemName
If i > ItemMax Then
Exit Do
End If
i = i + 1
Loop
'
Close #Fno
j = 1
Fno1 = 2
Open "OPCSample1.INI" For Input As #Fno1
Do While Not EOF(Fno1)
Input #Fno1, ItemName1
FrmOPC.cheng(j - 1).Text = ItemName1
If j > ItemMax Then
Exit Do
End If
j = j + 1
Loop
'
Close #Fno1
Exit Sub
LoadEnd:
If Fno > 0 Then
Close #Fno
End If
For i = 0 To ItemMax - 1
FrmOPC.ItemName(i).Text = ""
Next i
If Fno1 > 0 Then
Close #Fno1
End If
For j = 0 To ItemMax - 1
FrmOPC.cheng(j).Text = ""
Next j
End Sub
Private Sub CONNECT_Click()
Dim ItemServerHandles() As Long
Dim ClientHandles(1) As Long
Dim OPCItemIDs(1) As String
Dim Errors() As Long
Dim i As Integer
'
If bConnect = False Then
On Error GoTo ConnectError
Set OPCMyserver = New OPCServer
OPCMyserver.CONNECT FrmOPC.ServerName.List(ServerName.ListIndex), ""
Set OPCMygroups = OPCMyserver.OPCGroups
Set OPCMygroup = OPCMygroups.Add("Group1")
OPCMygroup.UpdateRate = Val(UpdateRateSet.Text)
Set OPCMyitems = OPCMygroup.OPCItems
For i = 1 To ItemMax
ClientHandles(1) = i
OPCItemIDs(1) = FrmOPC.ItemName(i - 1).Text
OPCMyitems.AddItems 1, OPCItemIDs, ClientHandles, ItemServerHandles, Errors ''',
If Errors(1) <> 0 Then
FrmOPC.Value(i - 1) = ""
End If
Next i
bConnect = True
For i = ItemName.LBound To ItemName.UBound
ItemName(i).Enabled = False
Next i
CONNECT.Caption = "断开连接"
OPCMygroup.IsActive = True
OPCMygroup.IsSubscribed = True
readvalue
Else
On Error Resume Next
OPCMygroup.IsActive = False
OPCMygroups.Remove OPCMygroup.ServerHandle
Set OPCMyitems = Nothing
Set OPCMyitem = Nothing
Set OPCMygroups = Nothing
Set OPCMygroup = Nothing
OPCMyserver.Disconnect
Set OPCMyserver = Nothing
bConnect = False
For i = ItemName.LBound To ItemName.UBound
ItemName(i).Enabled = True
Next i
CONNECT.Caption = "建立连接"
Exit Sub
End If
'
Exit Sub
ConnectError:
MsgBox "连接错误"
'
For i = 0 To ItemMax - 1
FrmOPC.Value(i) = ""
Next i
End Sub
Private Sub Form_Load()
Dim Getserver As OPCServer
Dim Servers As Variant
Dim i As Integer
'
ServerName.Clear
Set Getserver = New OPCServer
Servers = Getserver.GetOPCServers
'
For i = LBound(Servers) To UBound(Servers)
ServerName.AddItem Servers(i)
Next i
'
Set Getserver = Nothing
ServerName.ListIndex = 2
itemload
CONNECT_Click
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
Dim Fno As Integer
'
Dim j As Integer
Dim Fno1 As Integer
If bConnect = True Then
CONNECT_Click
End If
'
Fno = 1
Open "OPCSample.INI" For Output As #Fno
For i = 1 To ItemMax
Write #Fno, FrmOPC.ItemName(i - 1).Text
Next i
Close #Fno
Fno1 = 2
Open "OPCSample1.INI" For Output As #Fno1
For j = 1 To ItemMax
Write #Fno1, FrmOPC.cheng(j - 1).Text
Next j
Close #Fno1
End Sub
Private Sub readvalue()
On Error Resume Next
Dim anItem As OPCItem
'
For Each anItem In OPCMygroup.OPCItems
anItem.Read OPCDevice
FrmOPC.Value(anItem.ClientHandle - 1) = anItem.Value
FrmOPC.Time(anItem.ClientHandle - 1) = anItem.TimeStamp
FrmOPC.Quality(anItem.ClientHandle - 1) = anItem.Quality
Next anItem
'
Set anItem = Nothing
End Sub
Private Sub OPCMygroup_DataChange(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date)
Dim id As Integer
Dim i As Integer
'
For i = 1 To NumItems
id = ClientHandles(i) - 1
FrmOPC.Value(id) = ItemValues(i)
FrmOPC.Time(id) = TimeStamps(i)
FrmOPC.Quality(id) = Qualities(i)
Next i
End Sub
Private Sub OPCMyserver_ServerShutDown(ByVal Reason As String)
MsgBox "服务器关闭"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -