100分求教，如何在active dll程序中实现timer的功能

Question

不是要用dll实现timer，是要在自己编的dll中调用类似timer的功能，主要是像使用时间限制，比方说5秒之后执行一个函数，只要实现这个功能就行我试了一下创建timer，好像是不能在类模块中调用

Answer 1

Type: Class Modules
Name: CTimer.cls
Source:Option Explicit
Private iInterval As Long
Private id As LongPublic Item As VariantPublic Event ThatTime()Public Enum EErrorTimer
    eeBaseTimer = 13650     ' CTimer
    eeTooManyTimers         ' No more than 10 timers allowed per class
    eeCantCreateTimer       ' Can't create system timer
End EnumFriend Sub ErrRaise(e As Long)
    Dim sText As String, sSource As String
    If e > 1000 Then
        sSource = App.EXEName & ".WindowProc"
        Select Case e
        Case eeTooManyTimers
            sText = "No more than 10 timers allowed per class"
        Case eeCantCreateTimer
            sText = "Can't create system timer"
        End Select
        Err.Raise e Or vbObjectError, sSource, sText
    Else
        Err.Raise e, sSource
    End If
End Sub
Property Get Interval() As Long
    Interval = iInterval
End PropertyProperty Let Interval(iIntervalA As Long)
    Dim f As Boolean
    If iIntervalA > 0 Then        If iInterval = iIntervalA Then Exit Property        If iInterval Then
            f = TimerDestroy(Me)
        End If        iInterval = iIntervalA
        If TimerCreate(Me) = False Then ErrRaise eeCantCreateTimer
    Else
        If (iInterval > 0) Then
            iInterval = 0
            f = TimerDestroy(Me)
        End If
    End If
End PropertyPublic Sub PulseTimer()
    RaiseEvent ThatTime
End SubFriend Property Get TimerID() As Long
    TimerID = id
End PropertyFriend Property Let TimerID(idA As Long)
    id = idA
End PropertyPrivate Sub Class_Terminate()
    Interval = 0
End SubType: Modules
Name MTimer
Source:Option ExplicitPrivate Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As LongConst cTimerMax = 100Public aTimers(1 To cTimerMax) As CTimer
Private m_cTimerCount As IntegerFunction TimerCreate(timer As CTimer) As Boolean
    timer.TimerID = SetTimer(0&, 0&, timer.Interval, AddressOf TimerProc)
    If timer.TimerID Then
        TimerCreate = True
        Dim i As Integer
        For i = 1 To cTimerMax
            If aTimers(i) Is Nothing Then
                Set aTimers(i) = timer
                If (i > m_cTimerCount) Then
                    m_cTimerCount = i
                End If
                TimerCreate = True
                Exit Function
            End If
        Next
        timer.ErrRaise eeTooManyTimers
    Else
        timer.TimerID = 0
        timer.Interval = 0
    End If
End FunctionPublic Function TimerDestroy(timer As CTimer) As Long
    Dim i As Integer, f As Boolean    For i = 1 To m_cTimerCount
        If Not aTimers(i) Is Nothing Then
            If timer.TimerID = aTimers(i).TimerID Then
                f = KillTimer(0, timer.TimerID)
                Set aTimers(i) = Nothing
                TimerDestroy = True
                Exit Function
            End If
        End If
    Next
End Function
Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, _
                     ByVal idEvent As Long, ByVal dwTime As Long)
    Dim i As Integer    For i = 1 To m_cTimerCount
        If Not (aTimers(i) Is Nothing) Then
            If idEvent = aTimers(i).TimerID Then
                aTimers(i).PulseTimer
                Exit Sub
            End If
        End If
    Next
End Sub
Private Function StoreTimer(timer As CTimer)
    Dim i As Integer
    For i = 1 To m_cTimerCount
        If aTimers(i) Is Nothing Then
            Set aTimers(i) = timer
            StoreTimer = True
            Exit Function
        End If
    Next
End Function以上內容摘自 http://vbaccelerator.com

Answer 2

这个的用法跟timer控件一样吗？

Answer 3

试试SetTimer
参考
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcesdkr/htm/_wcesdk_win32_timerproc.asp

Answer 4

'窗体
Option Explicit
      Dim lngTimerID As Long
      Dim BlnTimer As BooleanPrivate Sub Command2_Click()
    End
End Sub      Private Sub Form_Load()
         BlnTimer = False
         Command1.Caption = "Start Timer"
      End Sub      Private Sub Command1_Click()
      'Starts and stops the timer.         If BlnTimer = False Then
            lngTimerID = SetTimer(0, 0, 100, AddressOf TimerProc)
            If lngTimerID = 0 Then
              MsgBox "Timer not created. Ending Program"
              Exit Sub
            End If
            BlnTimer = True
            Command1.Caption = "Stop Timer"
         Else
            lngTimerID = KillTimer(0, lngTimerID)
            If lngTimerID = 0 Then
               MsgBox "couldn't kill the timer"
            End If
            BlnTimer = False
            Command1.Caption = "Start Timer"
          End If      End Sub
'模块
Option Explicit      Declare Function SetTimer Lib "user32" _
            (ByVal hwnd As Long, _
            ByVal nIDEvent As Long, _
            ByVal uElapse As Long, _
            ByVal lpTimerFunc As Long) As Long      Declare Function KillTimer Lib "user32" _
            (ByVal hwnd As Long, _
            ByVal nIDEvent As Long) As Long      Global iCounter As Integer      Sub TimerProc(ByVal hwnd As Long, _
                     ByVal uMsg As Long, _
                     ByVal idEvent As Long, _
                     ByVal dwTime As Long)          iCounter = iCounter + 1
          Form1.Text1.Text = CStr(iCounter)
      End Sub

Answer 5

使用Suron128的代码搞定了，给分