xtimer.cls

基于事件驱动的串口通讯控件 消息帧数据格式: 1 0 A B X X 其中 10 为消息标识, AB表示文本长度,L=A*100+B XX为配位字符,任意 控制帧数据格式

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "XTimer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'****************************************************************************
' ：） 人人为我，我为人人 ：）
'枕善居汉化收藏整理
'发布日期：05/09/08
'描    述：基于事件驱动的串口通讯控件 Ver 1.0
'网    站：http://www.mndsoft.com/
'e-mail  ：[e-mail]
'OICQ    ：88382850
'****************************************************************************
Option Explicit
' Private storage for XTimer properties:
Private mlngTimerID As Long
Private mlngInterval As Long
Private mblnEnabled As Boolean

Event Tick()

Friend Property Get TimerID() As Long
On Error Resume Next
    TimerID = mlngTimerID
End Property

Public Property Get Enabled() As Boolean
On Error Resume Next
    Enabled = mblnEnabled
End Property

Public Property Let Enabled(ByVal NewValue As Boolean)
On Error Resume Next
    If NewValue = mblnEnabled Then Exit Property
    mblnEnabled = NewValue
    If mlngInterval = 0 Then Exit Property
    If mblnEnabled Then
        Debug.Assert mlngTimerID = 0
        mlngTimerID = BeginTimer(Me, mlngInterval)
    Else
        If mlngTimerID <> 0 Then
            Call EndTimer(Me)
            mlngTimerID = 0
        End If
    End If
End Property

Public Property Get Interval() As Long
On Error Resume Next
    Interval = mlngInterval
End Property
'
Public Property Let Interval(ByVal NewInterval As Long)
On Error Resume Next
    If NewInterval = mlngInterval Then Exit Property
    mlngInterval = NewInterval
    If mlngTimerID <> 0 Then
        Call EndTimer(Me)
        mlngTimerID = 0
    End If
    If (NewInterval <> 0) And mblnEnabled Then
        mlngTimerID = BeginTimer(Me, NewInterval)
    End If
End Property

Public Sub RaiseTick()
On Error Resume Next
    RaiseEvent Tick
End Sub

Private Sub Class_Terminate()
On Error Resume Next
    If mlngTimerID <> 0 Then KillTimer 0, mlngTimerID
End Sub