?? 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 '演示用的opc組
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() '連接著opc服務器的opc應用程序，在退出前必須斷開和opc服務器的連接，因為
'opc服務器不知道opc應用程序的退出，如不斷開連接，opc服務器占用的資源不
'會釋放，久之可能會使資源枯竭從而發生嚴重問題。
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() '對opc服務器訪問前，必須現在opc組添加要訪問的opc標簽
'本例添加的opc標簽的標志符和數目是固定的，但實際的opc應用程序
'要根據實際情況添加opc標簽
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
'按鍵事件處理內調用的“SyncWrite”子程序如下
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 + -