VB 纯代码实现Timer控件的功能

本博客有一篇类似的文章《VB 中运用 TimeSetEvent 代替 Timer 控件》与这篇不同。
本篇展示了另外两种方法,具体如下文所示。

方法1:
  用这个类可以替代VB自带的Timer控件,这样就不用在无窗体的项目中仅为了使用Timer而多加一个窗体了。我一般用在ActiveX exe中用来分离系统控制权,用Timer的好处是避免控制权死锁,这样也就模拟出了多线程(实际上是多进程),能给用户更好的体验。代码如下:
标准模块(mTimer.bas)

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.Collection

Public 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.bas)

Option Explicit

Private 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 Long

Private
m_TimerID As Long
Private
m_Interval As Long
Private
m_Enabled As Boolean

Public
Tag As Variant
Public Event
Timer()

Public Property Get Interval() As Long
Interval = m_Interval
End Property

Public Property Let
Interval( ByVal Value As Long )
m_Interval = Value
Enabled = m_Enabled
End Property

Public Property Get
Enabled() As Boolean
Interval = m_Enabled
End Property

Public Property Let
Enabled( ByVal Value As Boolean )
If Value Then
m_Enabled = StartTimer
Else
Call
StopTimer
End If
End Property

Private 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 Function

Friend Sub
PulseTimer()
RaiseEvent Timer
End Sub

Private 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 Sub

Private 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


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

Option Explicit

Const GWL_WNDPROC = (- 4 )

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( ByVal hWnd As Long , ByVal nIndex As Long , ByVal dwNewLong As Long ) As Long

Private 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 Long

Private Sub
Form_Load()
glngFuncAdd = SetWindowLong(hWnd, GWL_WNDPROC,
AddressOf WndProc_TimerTest)
Call SetTimer(hWnd, TIMERID, 500 , 0 &)
End Sub

Private 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 Explicit

Const WM_TIMER = &H113

Public 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 Long

Public
glngFuncAdd As Long

Public 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

 

你可能感兴趣的:(多线程,vb,VBA)