如何用纯代码实现timer控件的功能?

Question

请教高人： 
 如何用纯代码实现timer控件的功能? 如果不好实现的话,讲一讲vb实现timer控件背后的技术内幕. 
 谢谢．．

Answer 1

(声明：魏滔序原创，转贴请注明出处。)
        用这个类可以替代VB自带的Timer控件，这样就不用在无窗体的项目中仅为了使用Timer而多加一个窗体了。我一般用在ActiveX exe中用来分离系统控制权，用Timer的好处是避免控制权死锁，这样也就模拟出了多线程(实际上是多进程)，能给用户更好的体验。代码如下：
        想直接使用的请到这里下载：http://www.chenoe.com/developer/library/timer.dll
标准模块(mTimer):
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Public TimerColl As New VBA.CollectionPublic Sub TimeProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    Dim Timer As Timer, lpTimer As Long
    lpTimer = TimerColl("ID:" & idEvent)
    CopyMemory Timer, lpTimer, 4&
    Timer.PulseTimer
    CopyMemory Timer, 0&, 4&
End Sub类模块(Timer):
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 LongPrivate m_TimerID As Long
Private m_Interval As Long
Private m_Enabled As BooleanPublic Tag As Variant
Public Event Timer()Public Property Get Interval() As Long
    Interval = m_Interval
End PropertyPublic Property Let Interval(ByVal Value As Long)
    m_Interval = Value
    Enabled = m_Enabled
End PropertyPublic Property Get Enabled() As Boolean
    Interval = m_Enabled
End PropertyPublic Property Let Enabled(ByVal Value As Boolean)
    If Value Then
        m_Enabled = StartTimer
    Else
        Call StopTimer
    End If
End PropertyPrivate Function StartTimer() As Boolean
    If m_TimerID = 0 Then
        If m_Interval > 0 Then
            m_TimerID = SetTimer(0, 0, m_Interval, AddressOf TimeProc)
            If m_TimerID <> 0 Then
                TimerColl.Add ObjPtr(Me), "ID:" & m_TimerID
                StartTimer = True
            End If
        Else
            m_Enabled = True
        End If
    End If
End FunctionFriend Sub PulseTimer()
    RaiseEvent Timer
End SubPrivate Sub StopTimer()
    If m_TimerID <> 0 Then
        KillTimer 0, m_TimerID
        TimerColl.Remove "ID:" & m_TimerID
        m_TimerID = 0
        m_Enabled = False
    End If
End SubPrivate Sub Class_Terminate()
    Call StopTimer
End Sub使用方法：
Private WithEvents Timer1 As Timer
Private Sub Form_Load()
    Set Timer1 = New TimerLib.Timer
    Timer1.Interval = 1000
    Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
    Debug.Print Now
End Sub

Answer 2

'.frm 的代码, 添加 Command1
Private Sub Command1_Click()
   ForceStop = False
   Call TimCtl(Me, 100)
End SubPrivate Sub Form_Unload(Cancel As Integer)
   ForceStop = True
   End
End Sub'**************************
'.bas 的代码
Private Declare Function GetTickCount& Lib "kernel32" ()
Public ForceStop As Boolean, starttm&
Sub main()
   Form1.Show
End SubPublic Sub TimCtl(SelObj As Object, Msec As Long)
   Do
      DoEvents
      SelObj.Caption = Time
      starttm = GetTickCount
      Do
      Loop Until GetTickCount - starttm >= Msec Or ForceStop = True
   Loop Until ForceStop = True
End Sub

Answer 3

给个网页给你参考下http://www.vbaccelerator.com/home/VB/Code/Libraries/Subclassing/SSubTimer_ASM_Version/article.asp

Answer 4

原理很简单用SetTimer函数定义一个ID,并标志一个触发时间(以MS为单位)和回调函数地址.当指定的触发时间到了,系统就会调用那个指定的回调函数,并以你在SetTimer时定义的ID为参数,这样就可以区别多个定时器了.当不需要使用某个定时器时,就使用KillTimer函数把指定ID的定时器干掉就可以了.

Answer 5

'窗体代码：
Option ExplicitConst GWL_WNDPROC = (-4)Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate 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 LongPrivate Sub Form_Load()
    glngFuncAdd = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc_TimerTest)
    Call SetTimer(hWnd, TIMERID, 500, 0&)
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If glngFuncAdd > 0 Then Call SetWindowLong(hWnd, GWL_WNDPROC, glngFuncAdd)
    Call KillTimer(hWnd, TIMERID)
End Sub
'模块代码：
Option ExplicitConst WM_TIMER = &H113Public Const TIMERID = &H100 '自定义Timer的ID号Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPublic glngFuncAdd As LongPublic Function WndProc_TimerTest(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If wMsg = WM_TIMER Then
        If wParam = TIMERID Then
            Debug.Print Timer
        End If
    End If
    
    WndProc_TimerTest = CallWindowProc(glngFuncAdd, hWnd, wMsg, wParam, lParam)
End Function就这么简单。

Answer 6

'窗体代码：
Option ExplicitConst GWL_WNDPROC = (-4)Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate 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 LongPrivate Sub Form_Load()
    glngFuncAdd = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc_TimerTest)
    Call SetTimer(hWnd, TIMERID, 500, 0&)
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If glngFuncAdd > 0 Then Call SetWindowLong(hWnd, GWL_WNDPROC, glngFuncAdd)
    Call KillTimer(hWnd, TIMERID)
End Sub
'模块代码：
Option ExplicitConst WM_TIMER = &H113Public Const TIMERID = &H100 '自定义Timer的ID号Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPublic glngFuncAdd As LongPublic Function WndProc_TimerTest(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If wMsg = WM_TIMER Then
        If wParam = TIMERID Then
            Debug.Print Timer
        End If
    End If
    
    WndProc_TimerTest = CallWindowProc(glngFuncAdd, hWnd, wMsg, wParam, lParam)
End Function
就这么简单~

Answer 7

'窗体代码：
Option ExplicitConst GWL_WNDPROC = (-4)Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate 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 LongPrivate Sub Form_Load()
    glngFuncAdd = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc_TimerTest)
    Call SetTimer(hWnd, TIMERID, 500, 0&)
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If glngFuncAdd > 0 Then Call SetWindowLong(hWnd, GWL_WNDPROC, glngFuncAdd)
    Call KillTimer(hWnd, TIMERID)
End Sub
'模块代码：
Option ExplicitConst WM_TIMER = &H113Public Const TIMERID = &H100 '自定义Timer的ID号Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPublic glngFuncAdd As LongPublic Function WndProc_TimerTest(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If wMsg = WM_TIMER Then
        If wParam = TIMERID Then
            Debug.Print Timer
        End If
    End If
    
    WndProc_TimerTest = CallWindowProc(glngFuncAdd, hWnd, wMsg, wParam, lParam)
End Function
就这么简单~

Answer 8

可替代VB自带的Timer控件的Timer类  http://blog.csdn.net/modest/archive/2006/10/23/1346175.aspx

Answer 9

Public Declare Function GetTickCount Lib "kernel32" () As LongSub Pause(Howlong As Long)
    Dim u%, tick As Long
    tick = GetTickCount()
    Do
        u% = DoEvents
    Loop Until tick + Howlong < GetTickCount
End Sub隔多长时间就直接调用 pausse（时间长度）就行了 

Answer 10

谢谢大家，结贴。
楼上和CBM666的代码用循环加DOEVENTS费资源。
用
SetTimer 
KillTimer 
函数是更可行的办法。