coval.cls

这是一个实际的工程中所用的源程序

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "COval"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"No"
Attribute VB_Ext_KEY = "Collection" ,"CVector"
Attribute VB_Ext_KEY = "Member0" ,"CVector"
Option Explicit
'这是一个皮带数组结构
'
'mCol:存储各个秒数的数值,基于1的,长度=mUpperSecond+1
'iLoc:当前的最后赋值位置,赋值时,增加一个新的位置
'UpperSecond:数组的秒数上界,缺省10秒
'TotalNew:无参数,在新的位置iLoc上赋值
'
'只用于主累计值的直接赋值情况，检测或取得所处单元的值，从1..mUpperSecond
'    CheckUnit(atSecond):检测所处位置的单元值,从1..mUpperSecond
'    TotalUnit(atSecond):取所处单元的值,从1..mUpperSecond,合适的取值时间<= 1s
'
'用于主累计值的直接赋值或单元差值的赋值，检测或取得所处位置的值，从0..mUpperSecond。如果是单元取值，注意参数atSecond是基于0的.
'    CheckHistory(atSecond):检测所处位置的值,从0..mUpperSecond
'    TotalHistory(atSecond):取所处位置的值,从0..mUpperSecond,合适的取值时间<= 1s,但是也不能太短。
Public Event EvState(ByVal bRuning As Boolean)
Private mFlow    As Double
Private mSpeed   As Double
Private mRuning  As Boolean
Private mCol As Collection '基于1的
Private mUpperSecond As Long, mLowerSecond As Long '秒数上下界,0..mUpperSecond
Private iLoc     As Long '当前位置指针（已赋值）,基于0


Private Sub Add()
    Dim objNewMember As CVector
    Set objNewMember = New CVector
    mCol.Add objNewMember
    Set objNewMember = Nothing
End Sub

Private Function Vector(ByVal vSecond As Long) As CVector
'Vector:0..mUpperSecond
'mCol:1..mUpperSecond+1
  Set Vector = mCol(vSecond + 1)
End Function

Public Property Let UpperSecond(ByVal vUpperSecond As Long)
    If vUpperSecond > 10 Then
        Dim i As Long
        For i = 11 To vUpperSecond  '集合中的元素包括0秒的元素
            Call Add
        Next i
        mUpperSecond = vUpperSecond
    End If
End Property


Public Property Get UpperSecond() As Long
    UpperSecond = mUpperSecond
End Property

Private Sub Class_Initialize()
    '创建类后创建集合
    Dim i As Long
    Set mCol = New Collection
    mLowerSecond = 0
    mUpperSecond = 10
    For i = mLowerSecond To mUpperSecond  '集合中的元素包括0秒的元素
        Call Add '初始化 mCol(0),..,mCol(10)
    Next i
End Sub

Private Sub Class_Terminate()
    '类终止后破坏集合
    Set mCol = Nothing
End Sub
Public Property Let TotalNew(ByVal vTotal As Double)
    Dim at As Long
    'iLoc=(iLoc + 1) Mod (mUpperSecond + 1)
    iLoc = pSecond(mUpperSecond) '0位置的下一个位置是mUpperSecond
    at = iLoc
    Vector(at).TTotal = vTotal

End Property

Private Function pSecond(ByVal atSecond As Long) As Long '数组Vector（基于0的）中atSecond秒的位置
'注:在数组中定位:at等于(at + UpperSecond - LowerSecond + 1) Mod (UpperSecond - LowerSecond + 1),
'    前后n位置是:(at (+/-)n+ UpperSecond - LowerSecond + 1) Mod (UpperSecond - LowerSecond + 1)
'  Vector是基于0的.用于单元的截取时，atSecond应该是atSecond-1,否则有1秒的误差。

    pSecond = (iLoc - atSecond + mUpperSecond - mLowerSecond + 1) Mod (mUpperSecond - mLowerSecond + 1)
End Function
Public Property Get CheckUnit(ByVal atSecond As Long) As Double  '只察看,不清除
    Dim at0 As Long, at1 As Long
    Dim vGet As Double
    On Error GoTo err1
    at0 = pSecond(atSecond - 1): at1 = pSecond(atSecond)
    vGet = Vector(at0).TTotal - Vector(at1).TTotal
    '0s的值=1s的值
    If Abs(vGet) > 30 Then '清零,换物理地址或通信中断:V(at0)=0,V(at1)>100 初始:V(at0)>100,V(at1)=0
        vGet = 0 '定时器太长(>1),清零时会产生极小的误差
    End If
    CheckUnit = vGet
    Exit Property
err1:
    Debug.Assert False
    Err.Clear
    Resume Next
End Property
Public Property Get TotalUnit(ByVal atSecond As Long) As Double
'  返回:0,或实际值,然后清除累计值
    Dim at0 As Long, at1 As Long
    Dim vGet As Double
    On Error GoTo err1
    at0 = pSecond(atSecond - 1): at1 = pSecond(atSecond)
    vGet = Vector(at0).TTotal - Vector(at1).TTotal
    '0s的值=1s的值
    If Abs(vGet) > 30 Then '清零或通信中断:V(at0)=0,V(at1)>100 初始:V(at0)>100,V(at1)=0
        vGet = 0 '定时器太长(>1),清零时会产生极小的误差
    End If
    Vector(at1).TTotal = 0
    TotalUnit = vGet
    Exit Property
err1:
    Debug.Assert False
    Err.Clear
    Resume Next
End Property
Public Property Get TotalHistory(ByVal atSecond As Long) As Double
'  atSecond是基于0的.用于单元的截取时，atSecond应该是atSecond-1,否则有1秒的误差。
'  返回:0,或实际值
    Dim at1 As Long
    Dim vGet As Double
    On Error GoTo err1
    at1 = pSecond(atSecond)
    
    If Vector(at1).Flag = 1 Then
        vGet = 0
    Else
        vGet = Vector(at1).TTotal
        Vector(at1).Flag = 1 '清除标志,因为它已经被取出
    End If
    
    TotalHistory = vGet
    Exit Property
err1:
    Debug.Assert False
    Err.Clear
    Resume Next
End Property
Public Property Get CheckHistory(ByVal atSecond As Long) As Double
'  atSecond是基于0的.用于单元的截取时，atSecond应该是atSecond-1,否则有1秒的误差。
    Dim at1 As Long
    Dim vGet As Double
    On Error GoTo err1
    at1 = pSecond(atSecond)
    vGet = Vector(at1).TTotal
    CheckHistory = vGet
    Exit Function
err1:
    Debug.Assert False
    Err.Clear
    Resume Next
End Property

Public Property Let Flow(ByVal vFlow As Double)
    Dim i As Long
    Dim at As Long
    at = iLoc
    Vector(at).TFlow = vFlow
    mFlow = vFlow
End Property
Public Property Get Flow() As Double
    Flow = mFlow
End Property
Public Function getFlow(ByVal atSecond As Long) As Double
'    If (atSecond > mUpperSecond)  Then MsgBox "COval:" & vbCr & "取值点溢出"
    Dim at1 As Long
    at1 = pSecond(atSecond)
    getFlow = Vector(at1).TFlow
End Function

'
Public Property Let Speed(ByVal vSpeed As Double)
    
    mSpeed = vSpeed
    If mSpeed > 1 Then
        If mRuning = False Then
            mRuning = True
            RaiseEvent EvState(True)
        End If
    Else
        If mRuning = True Then
            mRuning = False
            RaiseEvent EvState(False)
        End If
    End If
End Property
Public Property Get Speed() As Double
    Speed = mSpeed
End Property
Public Property Get Runing() As Boolean
        Runing = mRuning
End Property
Public Property Let Runing(ByVal vRuning As Boolean)
    If vRuning Then
        mSpeed = 2.5
        If mRuning = False Then
            mRuning = True
            RaiseEvent EvState(True)
        End If
    Else
        mSpeed = 0
        If mRuning = True Then
            mRuning = False
            RaiseEvent EvState(False)
        End If
    End If
End Property