trendgraph.ctl

关于OPC的相关资料:OPC技术介绍.pdf,入门学习资料及VB源码

VERSION 5.00
Begin VB.UserControl TrendGraph 
   BackColor       =   &H00000000&
   ClientHeight    =   2952
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3552
   FillStyle       =   0  'Solid
   ForeColor       =   &H00000000&
   LockControls    =   -1  'True
   PropertyPages   =   "TrendGraph.ctx":0000
   ScaleHeight     =   2952
   ScaleWidth      =   3552
   ToolboxBitmap   =   "TrendGraph.ctx":002D
   Begin VB.Line linHorizon 
      BorderColor     =   &H00FFFFFF&
      X1              =   600
      X2              =   3000
      Y1              =   1920
      Y2              =   1920
   End
End
Attribute VB_Name = "TrendGraph"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Private Declare Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long

' OPC对象
Dim WithEvents objMyOpcServer As OPCServer
Attribute objMyOpcServer.VB_VarHelpID = -1
Dim WithEvents objMyOpcGroup As OPCGroup
Attribute objMyOpcGroup.VB_VarHelpID = -1
Dim objMyOpcGroups As OPCGroups

' 属性
Dim dRangeX As Double
Dim dRangeY As Double
Dim ocPointColor As OLE_COLOR
Dim bAutoLink As Boolean
Dim strProgID As String
Dim strItemID As String

' 内部工作变量
Dim g_bConnect As Boolean   ' 连接标志
Dim g_lNowTime As Long      ' 本次事件的发生时间
Dim g_lOldTime As Long      ' 上次事件的发生时间
Dim g_dPf As Double         ' 事件数
Dim g_dQuotient As Double
Dim g_bFirstPaint As Boolean

' 属性的初期值
Const conDefaultRangeX As Double = 10000
Const conDefaultRangeY As Double = 1
Const conDefaultPointColor As Long = &HFFFFFF
Const conDefaultLineColor As Long = &HFFFFFF
Const conDefaultBackColor As Long = &H0
Const conDefaultPointSize As Long = 1
Const conDefaultAutoLink As Boolean = False
Const conDefaultProgID As String = "OPCJ.DADemoServer.1"
Const conDefaultItemID As String = "SV1"

Public Sub Connect()
    ' 连接OPC服务器
    If Ambient.UserMode Then
        ' 连接OPC服务器仅限于运行模式
        Call OpcConnect(strProgID, strItemID)
    End If
End Sub

Public Sub Disconnect()
    ' 断开OPC服务器
    Call OpcDisConnect
End Sub

Public Sub Plot(ByVal dX As Double, ByVal dY As Double)
    ' 描绘趋势图
    Dim dNewQuotient As Double
    Dim dAbsolute As Double
    
    dNewQuotient = dX \ RangeX
    dAbsolute = Abs(dY)
    If dNewQuotient <> g_dQuotient Then
        ' 改变显示范围
        Cls
        g_dQuotient = dNewQuotient
        g_bFirstPaint = True
    End If
    
    If g_bFirstPaint Then
        ' 描绘趋势图的第一点
        PSet (ScaleWidth * ((dX Mod RangeX) / RangeX), (ScaleHeight / 2) - ((ScaleHeight / 2) * (dAbsolute / RangeY) * Sgn(dY))), PointColor
        g_bFirstPaint = False
    Else
        Line -(ScaleWidth * ((dX Mod RangeX) / RangeX), (ScaleHeight / 2) - ((ScaleHeight / 2) * (dAbsolute / RangeY) * Sgn(dY))), PointColor
    End If
End Sub

Private Sub objMyOpcServer_ServerShutDown(ByVal Reason As String)
    ' OPC服务器关机要求的处理
    Call Disconnect

    MsgBox Title:=Extender.Name, _
        Prompt:="OPC服务器关机。" & vbCr & """" & Reason & """", _
        Buttons:=vbInformation
End Sub

Private Sub objMyOpcGroup_DataChange(ByVal TransactionID As Long, ByVal NumItems As Long, _
        ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date)
    ' 数据变化事件的处理
    ' 记录时间和次数
    g_lOldTime = g_lNowTime
    g_lNowTime = timeGetTime
    g_dPf = g_dPf + 1

    ' 描绘趋势图
    Plot g_lNowTime, ItemValues(LBound(ItemValues))
End Sub

Private Sub UserControl_Initialize()
    ' 内部工作变量的初始化
    g_bConnect = False
    g_lNowTime = 0
    g_lOldTime = 0
    g_dPf = 0
    g_dQuotient = 0
    g_bFirstPaint = True

    ' 启动定时器
    timeBeginPeriod 1
End Sub

Private Sub UserControl_InitProperties()
    ' 属性的初始化
    dRangeX = conDefaultRangeX
    dRangeY = conDefaultRangeY
    ocPointColor = conDefaultPointColor
    
    linHorizon.BorderColor = conDefaultLineColor
    UserControl.BackColor = conDefaultBackColor
    UserControl.DrawWidth = conDefaultPointSize
    
    bAutoLink = conDefaultAutoLink
    strProgID = conDefaultProgID
    strItemID = conDefaultItemID

    If AutoLink Then
        ' 自动连接
        Call Connect
    End If
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    ' 保存属性的读取
    dRangeX = PropBag.ReadProperty("RangeX", conDefaultRangeX)
    dRangeY = PropBag.ReadProperty("RangeY", conDefaultRangeY)
    ocPointColor = PropBag.ReadProperty("PointColor", conDefaultPointColor)
    
    linHorizon.BorderColor = PropBag.ReadProperty("LineColor", conDefaultLineColor)
    UserControl.BackColor = PropBag.ReadProperty("BackColor", conDefaultBackColor)
    UserControl.DrawWidth = PropBag.ReadProperty("PointSize", conDefaultPointSize)
    
    AutoLink = PropBag.ReadProperty("AutoLink", conDefaultAutoLink)
    ProgID = PropBag.ReadProperty("ProgID", conDefaultProgID)
    ItemID = PropBag.ReadProperty("ItemID", conDefaultItemID)
    
    If AutoLink Then
        ' 自动连接
        Call Connect
    End If
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    ' 属性的保存
    PropBag.WriteProperty "RangeX", dRangeX, conDefaultRangeX
    PropBag.WriteProperty "RangeY", dRangeY, conDefaultRangeY
    PropBag.WriteProperty "PointColor", ocPointColor, conDefaultPointColor
    
    PropBag.WriteProperty "LineColor", linHorizon.BorderColor, conDefaultLineColor
    PropBag.WriteProperty "BackColor", UserControl.BackColor, conDefaultBackColor
    PropBag.WriteProperty "PointSize", UserControl.DrawWidth, conDefaultPointSize

    PropBag.WriteProperty "AutoLink", AutoLink, conDefaultAutoLink
    PropBag.WriteProperty "ProgID", strProgID, conDefaultProgID
    PropBag.WriteProperty "ItemID", strItemID, conDefaultItemID
End Sub

Private Sub UserControl_Terminate()
    ' 断开OPC服务器
    Call Disconnect
    
    ' 停止定时器
    timeEndPeriod 1
End Sub

Private Sub UserControl_Resize()
    ' 控件大小变化的处理
    linHorizon.X1 = 0
    linHorizon.Y1 = ScaleHeight / 2
    linHorizon.X2 = ScaleWidth
    linHorizon.Y2 = ScaleHeight / 2
End Sub

' 表示X轴的范围
Public Property Get RangeX() As Double
    RangeX = dRangeX
End Property

Public Property Let RangeX(ByVal dNewValue As Double)
    dRangeX = dNewValue
    PropertyChanged "RangeX"
End Property

' 表示Y轴的范围
Public Property Get RangeY() As Double
    RangeY = dRangeY
End Property

Public Property Let RangeY(ByVal dNewValue As Double)
    dRangeY = dNewValue
    PropertyChanged "RangeY"
End Property

' 图的颜色
Public Property Get PointColor() As OLE_COLOR
    PointColor = ocPointColor
End Property

Public Property Let PointColor(ByVal ocNewValue As OLE_COLOR)
    ocPointColor = ocNewValue
    PropertyChanged "PointColor"
End Property

' 中心线的颜色
Public Property Get LineColor() As OLE_COLOR
    LineColor = linHorizon.BorderColor
End Property

Public Property Let LineColor(ByVal ocNewValue As OLE_COLOR)
    linHorizon.BorderColor = ocNewValue
    PropertyChanged "LineColor"
End Property

' 背景的颜色
Public Property Get BackColor() As OLE_COLOR
    BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal ocNewValue As OLE_COLOR)
    UserControl.BackColor = ocNewValue
    PropertyChanged "BackColor"
End Property

' 图的宽
Public Property Get PointSize() As Long
    PointSize = UserControl.DrawWidth
End Property

Public Property Let PointSize(ByVal lNewValue As Long)
    UserControl.DrawWidth = lNewValue
    PropertyChanged "PointSize"
End Property

' 是否自动连接?
Public Property Get AutoLink() As Boolean
    AutoLink = bAutoLink
End Property

Public Property Let AutoLink(ByVal bNewValue As Boolean)
    bAutoLink = bNewValue
    PropertyChanged "AutoLink"
End Property

' OPC的设置
Public Property Get ProgID() As String
    ProgID = strProgID
End Property

Public Property Let ProgID(ByVal strNewValue As String)
    strProgID = strNewValue
    PropertyChanged "ProgID"
End Property

Public Property Get ItemID() As String
    ItemID = strItemID
End Property

Public Property Let ItemID(ByVal strNewValue As String)
    strItemID = strNewValue
    PropertyChanged "ItemID"
End Property

' 读取数据的时间间隔(仅用于运行模式)
Public Property Get Time() As Long
    Time = Abs(g_lNowTime - g_lOldTime)
End Property

Public Property Let Time(ByVal lNewValue As Long)
    ' 错误，只读用属性
    Err.Raise Number:=383
End Property

' 读取数据的次数(仅用于运行模式)
Public Property Get Pf() As Double
    Pf = g_dPf
End Property

Public Property Let Pf(ByVal dNewValue As Double)
    ' 错误，只读用属性
    Err.Raise Number:=383
End Property

Public Sub ShowAboutBox()
Attribute ShowAboutBox.VB_UserMemId = -552
    ' 版本信息
    dlgAbout.Show vbModal
    Unload dlgAbout
    Set dlgAbout = Nothing
End Sub

Private Sub OpcConnect(ByVal strProgID As String, ByVal strItemID As String)
    Dim myOpcServer As OPCServer
    Dim myOpcItems As OPCItems
    Dim myOpcGroups As OPCGroups
    Dim myOpcGroup As OPCGroup
    Dim strNode As String
    Dim lLength As Long
    
    ' 连接OPC服务器
    If g_bConnect Then Exit Sub
    
    Set myOpcServer = New OPCServer
    
    If Left(strProgID, 2) = "\\" Then
        ' 连接远程OPC服务器
        lLength = InStr(3, strProgID, "\")
        If lLength = 0 Then
            MsgBox Title:=Extender.Name, _
                Prompt:="程序标识符不正确。" & vbCr & "(" & strProgID & ")", _
                Buttons:=vbExclamation
            Set myOpcServer = Nothing
            Exit Sub
        End If
        strNode = Left(strProgID, lLength - 1)
        strProgID = Right(strProgID, Len(strProgID) - lLength)
        
        On Error GoTo ConnectError
        myOpcServer.Connect strProgID, strNode
        On Error GoTo 0
    Else
        ' 连接本地OPC服务器
        On Error GoTo ConnectError
        myOpcServer.Connect strProgID
        On Error GoTo 0
    End If
    
    ' OPC组的添加
    Set myOpcGroups = myOpcServer.OPCGroups
    Set myOpcGroup = myOpcGroups.Add("MyGroup")
    myOpcGroup.UpdateRate = 10          ' 设置更新周期为10毫秒。
    myOpcGroup.IsSubscribed = True      ' 使数据变化事件有效。
    Set myOpcItems = myOpcGroup.OPCItems
    
    Dim ItemServerHandles() As Long
    Dim ItemServerErrors() As Long
    Dim RequestedDataTypes(1) As Integer
    Dim AccessPaths As Variant
    Dim ClientHandles(1) As Long
    Dim OPCItemIDs(1) As String

    ' OPC项的添加
    OPCItemIDs(1) = strItemID
    ClientHandles(1) = 1
    RequestedDataTypes(1) = vbDouble
    myOpcItems.AddItems 1, OPCItemIDs, ClientHandles, ItemServerHandles, _
        ItemServerErrors, RequestedDataTypes, AccessPaths
    
    Set objMyOpcServer = myOpcServer
    Set objMyOpcGroups = myOpcGroups
    Set objMyOpcGroup = myOpcGroup

    g_bConnect = True
    Exit Sub

ConnectError:
    ' OPC服务器连接错误
    Set myOpcServer = Nothing
    
    MsgBox Title:=Extender.Name, _
        Prompt:="程序标识符错误。" & vbCr & "(" & ProgID & ")", _
        Buttons:=vbExclamation
End Sub

Private Sub OpcDisConnect()
    ' 断开OPC服务器
    If Not g_bConnect Then Exit Sub
    
    objMyOpcGroups.RemoveAll
    objMyOpcServer.Disconnect
    
    Set objMyOpcGroup = Nothing
    Set objMyOpcGroups = Nothing
    Set objMyOpcServer = Nothing
    
    g_bConnect = False
End Sub