📄 form1.frm
字号:
VERSION 5.00
Begin VB.Form fmMain
Caption = "OPC Application Demo"
ClientHeight = 6435
ClientLeft = 60
ClientTop = 345
ClientWidth = 8100
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 6435
ScaleWidth = 8100
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox txbBar
Alignment = 1 'Right Justify
Height = 375
Index = 8
Left = 6960
TabIndex = 26
Text = "0"
Top = 5040
Width = 855
End
Begin VB.TextBox txbBar
Alignment = 1 'Right Justify
Height = 375
Index = 7
Left = 6000
TabIndex = 25
Text = "0"
Top = 5040
Width = 855
End
Begin VB.TextBox txbBar
Alignment = 1 'Right Justify
Height = 375
Index = 6
Left = 5040
TabIndex = 24
Text = "0"
Top = 5040
Width = 855
End
Begin VB.TextBox txbBar
Alignment = 1 'Right Justify
Height = 375
Index = 5
Left = 4080
TabIndex = 23
Text = "0"
Top = 5040
Width = 855
End
Begin VB.TextBox txbBar
Alignment = 1 'Right Justify
Height = 375
Index = 4
Left = 3120
TabIndex = 22
Text = "0"
Top = 5040
Width = 855
End
Begin VB.TextBox txbBar
Alignment = 1 'Right Justify
Height = 375
Index = 3
Left = 2160
TabIndex = 21
Text = "0"
Top = 5040
Width = 855
End
Begin VB.TextBox txbBar
Alignment = 1 'Right Justify
Height = 375
Index = 2
Left = 1200
TabIndex = 14
Text = "0"
Top = 5040
Width = 855
End
Begin VB.PictureBox picBar
Height = 3135
Index = 8
Left = 6960
ScaleHeight = 205
ScaleMode = 3 'Pixel
ScaleWidth = 53
TabIndex = 12
Top = 1320
Width = 855
End
Begin VB.PictureBox picBar
Height = 3135
Index = 7
Left = 6000
ScaleHeight = 205
ScaleMode = 3 'Pixel
ScaleWidth = 53
TabIndex = 11
Top = 1320
Width = 855
End
Begin VB.PictureBox picBar
Height = 3135
Index = 6
Left = 5040
ScaleHeight = 205
ScaleMode = 3 'Pixel
ScaleWidth = 53
TabIndex = 10
Top = 1320
Width = 855
End
Begin VB.PictureBox picBar
Height = 3135
Index = 5
Left = 4080
ScaleHeight = 205
ScaleMode = 3 'Pixel
ScaleWidth = 53
TabIndex = 9
Top = 1320
Width = 855
End
Begin VB.PictureBox picBar
Height = 3135
Index = 4
Left = 3120
ScaleHeight = 205
ScaleMode = 3 'Pixel
ScaleWidth = 53
TabIndex = 8
Top = 1320
Width = 855
End
Begin VB.PictureBox picBar
Height = 3135
Index = 3
Left = 2160
ScaleHeight = 205
ScaleMode = 3 'Pixel
ScaleWidth = 53
TabIndex = 7
Top = 1320
Width = 855
End
Begin VB.PictureBox picBar
Height = 3135
Index = 2
Left = 1200
ScaleHeight = 205
ScaleMode = 3 'Pixel
ScaleWidth = 53
TabIndex = 6
Top = 1320
Width = 855
End
Begin VB.PictureBox picBar
Height = 3135
Index = 1
Left = 240
ScaleHeight = 205
ScaleMode = 3 'Pixel
ScaleWidth = 53
TabIndex = 5
Top = 1320
Width = 855
End
Begin VB.TextBox txbBar
Alignment = 1 'Right Justify
Height = 375
Index = 1
Left = 240
TabIndex = 3
Text = "0"
Top = 5040
Width = 855
End
Begin VB.Timer tmUpdate
Left = 0
Top = 5640
End
Begin VB.CommandButton btnAddItem
Caption = "加项"
Height = 615
Left = 2280
TabIndex = 2
Top = 240
Width = 1695
End
Begin VB.CommandButton btnQuit
Caption = "退出"
Height = 495
Left = 6000
TabIndex = 1
Top = 5760
Width = 1815
End
Begin VB.CommandButton btnConnect
Caption = "连接"
Height = 615
Left = 240
TabIndex = 0
Top = 240
Width = 1695
End
Begin VB.Label lbBar
Alignment = 1 'Right Justify
Caption = "####.###"
Height = 375
Index = 8
Left = 6960
TabIndex = 20
Top = 4560
Width = 855
End
Begin VB.Label lbBar
Alignment = 1 'Right Justify
Caption = "####.###"
Height = 375
Index = 7
Left = 6000
TabIndex = 19
Top = 4560
Width = 855
End
Begin VB.Label lbBar
Alignment = 1 'Right Justify
Caption = "####.###"
Height = 375
Index = 6
Left = 5040
TabIndex = 18
Top = 4560
Width = 855
End
Begin VB.Label lbBar
Alignment = 1 'Right Justify
Caption = "####.###"
Height = 375
Index = 5
Left = 4080
TabIndex = 17
Top = 4560
Width = 855
End
Begin VB.Label lbBar
Alignment = 1 'Right Justify
Caption = "####.###"
Height = 375
Index = 4
Left = 3120
TabIndex = 16
Top = 4560
Width = 855
End
Begin VB.Label lbBar
Alignment = 1 'Right Justify
Caption = "####.###"
Height = 375
Index = 3
Left = 2160
TabIndex = 15
Top = 4560
Width = 855
End
Begin VB.Label lbBar
Alignment = 1 'Right Justify
Caption = "####.###"
Height = 375
Index = 2
Left = 1200
TabIndex = 13
Top = 4560
Width = 855
End
Begin VB.Label lbBar
Alignment = 1 'Right Justify
Caption = "####.###"
Height = 375
Index = 1
Left = 240
TabIndex = 4
Top = 4560
Width = 855
End
End
Attribute VB_Name = "fmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Base 1
Option Explicit
' OPC对象的声明
Dim WithEvents objServer As OPCServer
Attribute objServer.VB_VarHelpID = -1
Dim objGroups As OPCGroups
Dim objTestGrp As OPCGroup
Dim objItems As OPCItems
Dim lServerHandles() As Long
Sub Connect(strProgID As String, Optional strNode As String)
If objServer Is Nothing Then
' 建立一个OPC服务器对象
Set objServer = New OPCServer
End If
If objServer.ServerState = OPCDisconnected Then
' 连接OPC服务器
objServer.Connect strProgID, strNode
End If
If objGroups Is Nothing Then
' 建立一个OPC组集合
Set objGroups = objServer.OPCGroups
End If
If objTestGrp Is Nothing Then
' 添加一个OPC组
Set objTestGrp = objGroups.Add("TestGrp")
End If
End Sub
Sub Disconnect()
Dim lErrors() As Long
If Not objItems Is Nothing Then
If objItems.Count > 0 Then
' 清除OPC项
objItems.Remove 8, lServerHandles, lErrors
End If
Set objItems = Nothing
End If
If Not objTestGrp Is Nothing Then
' 清除OPC组
objGroups.Remove "TestGrp"
Set objTestGrp = Nothing
End If
If Not objGroups Is Nothing Then
Set objGroups = Nothing
End If
If Not objServer Is Nothing Then
If objServer.ServerState <> OPCDisconnected Then
' 断开OPC服务器.
objServer.Disconnect
End If
Set objServer = Nothing
End If
End Sub
Sub AddItem()
Dim strItemIDs(8) As String
Dim lClientHandles(8) As Long
Dim lErrors() As Long
Dim I As Integer
If objTestGrp Is Nothing Then
Exit Sub
End If
If Not objItems Is Nothing Then
If objItems.Count > 0 Then
Exit Sub
End If
End If
' 设置组活动状态
objTestGrp.IsActive = True
' 取消组非同期通知
objTestGrp.IsSubscribed = False
' 建立OPC项集合
Set objItems = objTestGrp.OPCItems
' 生成从TAG1到TAG8的项标识符
For I = 1 To 8
strItemIDs(I) = "TAG" & I
lClientHandles(I) = I
Next
' 添加OPC项
Call objItems.AddItems(8, strItemIDs, _
lClientHandles, lServerHandles, lErrors)
End Sub
Sub SyncRead(nSource As Integer, ByRef vtItemValues() As Variant, _
ByRef lErrors() As Long)
If objTestGrp Is Nothing Then
Exit Sub
End If
If objTestGrp.OPCItems.Count > 0 Then
' 同期读取
objTestGrp.SyncRead nSource, 8, lServerHandles, _
vtItemValues, lErrors
End If
End Sub
Sub SyncWrite(nIndex As Integer, ByRef vtItemValues() As Variant, _
ByRef lErrors() As Long)
Dim lHandle(1) As Long
If objTestGrp Is Nothing Then
Exit Sub
End If
If objTestGrp.OPCItems.Count > 0 Then
lHandle(1) = lServerHandles(nIndex)
' 同期写入
objTestGrp.SyncWrite 1, lHandle(), _
vtItemValues, lErrors
End If
End Sub
Private Sub Form_Load()
tmUpdate.Enabled = False
tmUpdate.Interval = 1000
End Sub
Private Sub Form_Unload(Cancel As Integer)
' 调用Disconnect子程序
Call Disconnect
End Sub
Private Sub btnConnect_Click()
' 调用Connect子程序
Call Connect("OPCJ.SampleServer.1")
End Sub
Private Sub btnAddItem_Click()
' 调用AddItem子程序
Call AddItem
If Not objTestGrp Is Nothing Then
If objTestGrp.OPCItems.Count > 0 Then
' 启动定时器
tmUpdate.Enabled = True
End If
End If
End Sub
Private Sub btnQuit_Click()
' 卸载窗体
Unload fmMain
End Sub
Private Sub tmUpdate_Timer()
Dim vtItemValues() As Variant
Dim lErrors() As Long
Dim strBuf As String
Dim nWidth As Integer
Dim nHeight As Integer
Dim nDrawHeight As Integer
Dim sglScale As Single
Dim I As Integer
' 同期读取
SyncRead OPCCache, vtItemValues, lErrors
' 棒图的表示
For I = 1 To 8
' 数据的格式化
strBuf = Format(vtItemValues(I), "###.000")
' 表示数据字符串
lbBar(I).Caption = strBuf
' 计算棒的宽和高
nWidth = picBar(I).ScaleWidth
nHeight = picBar(I).ScaleHeight
sglScale = vtItemValues(I) / 100
nDrawHeight = CInt(nHeight * sglScale)
' 清除现棒图
picBar(I).Cls
' 绘制棒图
picBar(I).Line (0, nHeight - nDrawHeight)-(nWidth, nHeight), _
RGB(255, 0, 0), BF
Next
End Sub
Private Sub txbBar_KeyPress(Index As Integer, KeyAscii As Integer)
Dim strData As String
Dim vtItemData(1) As Variant
Dim lError() As Long
' 是回车键?
If KeyAscii = Asc(vbCr) Then
' 得到输入的字符串
strData = txbBar(Index).Text
' 转换成单精度浮点数
vtItemData(1) = CSng(strData)
' 同期写入
SyncWrite Index, vtItemData, lError
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -