VERSION 5.00
Begin VB.UserControl TrendGraph 
   BackColor       =   &H00000000&
   ClientHeight    =   4605
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6015
   FillStyle       =   0  'Solid
   ForeColor       =   &H00000000&
   LockControls    =   -1  'True
   PropertyPages   =   "TrendGraph.ctx":0000
   ScaleHeight     =   4605
   ScaleWidth      =   6015
   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 = False
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 = "OPC.SimaticNet"
Const conDefaultItemID As String = "ytwzm1kd"

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