Office中国论坛/Access中国论坛

标题: 为ACCESS添加多个Timer功能 [打印本页]
作者: andymark    时间: 2008-3-18 23:07
标题: 为ACCESS添加多个Timer功能
众所周知，ACCESS只有一个Timer事件，并不能处理多个触发事件，感觉十分不爽。
     现在我们可以借助API轻松实现多个定时器，而且调用也比较方便，下面是个简单的例子

   
'模块代码:

'===============================================================
'功能: 添加多个计时器
'用法: 设置计时器 SetTimer Me.hwnd, 1, 10000, AddressOf TimerProc1
' 关闭计时器 KillTimer Me.hwnd, 1
'作者: andymark
' QQ : 42503577 ewang11@163.com
'
'=================================================================


Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
'创建一个计时器
'参数: hwnd 窗口句柄
' nIDEvent 定时器ID，多个定时器时，可以通过该ID判断是哪个定时器
' uElapse 时间间隔,单位为毫秒
' lpTimerFunc 回调函数

Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
'关闭销毁计时器


'Timer回调涵数
Public Sub TimerProc1(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
MsgBox "测试第1个Timer事件"
End Sub
Public Sub TimerProc2(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
MsgBox "测试第2个Timer事件"
End Sub

Public Sub TimerProc3(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
MsgBox "测试第3个Timer事件"
End Sub


'窗体代码

Private Sub Form_Load()
'设置10秒间隔,调用回调涵数TimerProc1
SetTimer Me.hwnd, 1, 10000, AddressOf TimerProc1
'设置4秒间隔,调用回调涵数TimerProc2
SetTimer Me.hwnd, 2, 4000, AddressOf TimerProc2
'设置14秒间隔,调用回调涵数TimerProc3
SetTimer Me.hwnd, 3, 14000, AddressOf TimerProc3
End Sub

Private Sub Form_Unload(Cancel As Integer)
'关闭所有计时器
KillTimer Me.hwnd, 1
KillTimer Me.hwnd, 2
KillTimer Me.hwnd, 3
End Sub

作者: gdfsslec    时间: 2008-3-18 23:31
沙发，支持版主，谢谢版主
作者: tmtony    时间: 2008-3-18 23:41
不错, 可用到,以前使用多个子窗体来实现
作者: huangqinyong    时间: 2008-3-19 00:41
作者: tanhong    时间: 2008-3-19 09:31
好实例哦，收下学习
作者: v_tang    时间: 2008-3-19 11:30
好东西，支持一下！！！
作者: chinj    时间: 2008-5-11 09:56
感谢分享。
作者: chinj    时间: 2008-5-11 12:31
收藏，备用。
作者: 13912668356    时间: 2008-5-11 21:37
好东西，支持一下！！！
作者: liaoliao    时间: 2008-8-2 18:20
[:45] [:45] [:45] 已下载
作者: lkkl66    时间: 2008-8-3 00:09
嗅一嗅！珍藏！
作者: malee189    时间: 2008-10-14 18:05
good
作者: sheandme0    时间: 2008-10-28 19:53
看看啊  学习下下
作者: yori2007    时间: 2008-12-15 14:12
[:31] [:50]
作者: YCLOVE    时间: 2008-12-25 22:11
谢谢分享
作者: uranus1997    时间: 2008-12-30 14:47
学习[:50]
作者: xianbin555    时间: 2009-1-27 14:29
我正需要，谢谢
作者: jeckensky    时间: 2009-1-30 18:23
太强了，值得好好学习。新年快乐哦。
作者: beafhorse    时间: 2009-2-7 15:30
顶顶顶,好东西
作者: opennms    时间: 2009-2-8 09:59
bucuo
作者: cadgeeman    时间: 2009-3-31 14:58
好东西，学习一下！！！
作者: cadgeeman    时间: 2009-3-31 15:01
好东西，不错！！！
作者: szyewj    时间: 2009-4-17 11:51
不错, 可用到,以前使用多个子窗体来实现
作者: asklove    时间: 2009-4-23 08:56
收藏良品
作者: 345778796    时间: 2009-4-24 18:54
好东西，支持一下！！！
作者: 唐玉娥    时间: 2009-4-27 23:22
好东东，以前全部都是用多个子窗体搞定的。 1# andymark
作者: jsan999    时间: 2009-5-16 17:38
正是好讲评里
作者: fanz16163    时间: 2009-5-25 15:38
学习学习
作者: 3236235    时间: 2009-9-24 14:46
学习一下
作者: chaojianan    时间: 2009-9-26 20:33
谢谢分享，收藏了。
作者: leijiqiang    时间: 2009-10-13 21:25
这是好东西
作者: leijiqiang    时间: 2009-10-17 16:04
非常不错,嗯~
作者: elong    时间: 2009-10-31 19:36
谢谢,分享
作者: ztalex_ywt    时间: 2009-11-21 15:08
学习
作者: chenzhirong2008    时间: 2009-11-28 17:59
太粗燥了. 给你定时器类.

'* ******************************************** *

'*  模块名称：Timer.cls

'*  功能：在VB类模块中使用计时器

'* ******************************************** *



Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _
    Source As Any, ByVal Length 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 m_Tag As String

Private m_TimerID As Long

Private m_Enabled As Boolean

Private m_Interval As Long

Private m_EventEnter As Boolean         '事件实例标识, 防止一个早期实例未结束之前开始另一个实例

Public Event ThatTime()

Private Sub Class_Initialize()

    m_Interval = 0

End Sub

Private Sub Class_Terminate()

    If m_TimerID <> 0 Then KillTimer 0, m_TimerID

End Sub

Public Property Get Interval() As Long

    Interval = m_Interval

End Property

Public Property Let Interval(ByVal New_Value As Long)
   
    If New_Value > 0 Then
        '如果事件间隔相同, 退出
        If m_Interval = New_Value Then Exit Property
        
        If m_Enabled Then
            '如果类为Enable, 创建一个新的定时器
            
            m_Interval = New_Value
            '先销毁假设存在的旧定时器,再启动新定时器
            If m_TimerID <> 0 Then KillTimer 0, m_TimerID
            m_TimerID = SetTimer(0, 0, m_Interval, GetFuncAddr(10))     '注意回调函数地址,TimerProc为第10个函数
        
        Else
        ' 定时器disable, 仅修改时间间隔
            m_Interval = New_Value
        End If
        
    Else
   
        '新的事件间隔小于等于0, 销毁定时器
        m_Interval = 0
        If m_TimerID <> 0 Then KillTimer 0, m_TimerID
        m_TimerID = 0
        
    End If

End Property

Public Property Get Enabled() As Boolean

    Enabled = m_Enabled

End Property

Public Property Let Enabled(ByVal New_Value As Boolean)

    If New_Value = m_Enabled Then Exit Property
   
    If New_Value Then
   
        '新值允许定时器启动
        m_Enabled = New_Value
        
        If m_TimerID <> 0 Then      '如果存在旧定时器, 先销毁
            KillTimer 0, m_TimerID
            m_TimerID = 0
        End If
        
        '检查时间间隔, 如果>0 则启动新定时器
        If m_Interval > 0 Then
            m_TimerID = SetTimer(0, 0, m_Interval, GetFuncAddr(10))         '注意回调函数地址,TimerProc为第10个函数
        End If
        
    Else
   
        '新值设定时器disable,销毁定时器
        m_Enabled = False
        If m_TimerID <> 0 Then KillTimer 0, m_TimerID
        m_TimerID = 0
        
    End If

End Property

Public Property Get Tag() As String

    Tag = m_Tag
End Property

Public Property Let Tag(New_Value As String)

    m_Tag = New_Value
End Property

Private Function GetFuncAddr(ByVal IndexOfFunc As Long) As Long
'IndexOfFunc -- 类中第几个函数??
'是从某个类模块中最顶端的函数或属性算起,他是第几个函数

'这个参数有讲究...
'1. 当被查找的函数为 公用函数时,它的值就是自顶端算起的第几个函数,比如你在类模块中最顶端写的一个公用函数 WndProc,那么就传 1
'     如果是第2个公用函数或属性那么就传 2 依次...  注意,计算的时候要算上公用属性,公用属性也要算上,属性相当于函数,算做一个
'
'2. 当被查找的函数为 局部函数时,也就是说如果是 Private 修饰的函数,则此参数值为 所有公用函数个数 + 这是第 N 个私有函数
'     也是从顶端算起 , 同样包括属性

Static AsmCode(33) As Byte

Dim pThis As Long, pVtbl As Long, pFunc As Long
   

    pThis = ObjPtr(Me)

    CopyMemory pVtbl, ByVal pThis, 4

    CopyMemory pFunc, ByVal pVtbl + (6 + IndexOfFunc) * 4, 4

    AsmCode(0) = &H55

    AsmCode(1) = &H8B: AsmCode(2) = &HEC

    CopyMemory AsmCode(3), &H1475FF, 3

    CopyMemory AsmCode(6), &H1075FF, 3

    CopyMemory AsmCode(9), &HC75FF, 3

    CopyMemory AsmCode(12), &H875FF, 3

    AsmCode(15) = &HB9

    CopyMemory AsmCode(16), pThis, 4

    AsmCode(20) = &H51

    AsmCode(21) = &HE8

    CopyMemory AsmCode(22), pFunc - VarPtr(AsmCode(21)) - 5, 4

    AsmCode(26) = &H8B: AsmCode(27) = &HE5

    AsmCode(28) = &H5D

    AsmCode(29) = &HC2

    CopyMemory AsmCode(30), 16, 4

    GetFuncAddr = VarPtr(AsmCode(0))

End Function


Private Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)

    '如果这个事件的一个早期实例仍然在进行时，不要产生此事件。
    If m_EventEnter Then Exit Sub
   
    'm_EventEnter 标志将阻塞这个事件的未来实例直到当前的事例完成。
    m_EventEnter = True
   
'    Debug.Print "raise event"
    ' Generate the event
    RaiseEvent ThatTime
   
    ' 允许这个事件再次进入 TimerProc。
    m_EventEnter = False

End Sub
作者: wdq    时间: 2009-11-29 13:20
作者: c101    时间: 2009-12-4 21:49
谢谢分享
作者: like5188    时间: 2009-12-21 12:30
ddddddd
作者: qimingju    时间: 2009-12-24 08:31
这个不错哦，一定要顶顶
作者: liaoqiang234    时间: 2010-1-2 21:35
谢分享
作者: 發2639    时间: 2010-1-11 23:53
看看看
作者: xuwenning    时间: 2010-1-12 08:49
谢谢分享
学习
学习
作者: LeeTien    时间: 2010-4-12 21:09
楼主强悍啊
作者: zhao__feng    时间: 2010-4-12 21:35
好实例哦，收下学习
作者: yanwei82123300    时间: 2010-4-13 08:15
支持版主，谢谢版主
作者: yuayua23    时间: 2010-4-13 23:45
学习谢谢
作者: yuayua23    时间: 2010-4-13 23:45
学习谢谢
作者: xiangtyAc    时间: 2010-5-13 21:35
不错，很实用！·
作者: totodon    时间: 2010-6-16 15:22
进来学习
作者: txywzj    时间: 2010-6-21 10:34
1# andymark 学习一下
作者: c101    时间: 2010-6-22 22:30
谢谢版主
作者: Y9X    时间: 2010-11-15 21:05
谢谢老大
作者: liangshiheng    时间: 2011-5-12 17:12
ddddd
作者: 崔延东    时间: 2011-7-25 18:31
学习
作者: TWH852002    时间: 2011-12-21 08:07
好，谢谢了
作者: faith200703    时间: 2012-1-2 15:05
{:soso_e100:}{:soso_e100:}{:soso_e100:}
作者: 雷鸣    时间: 2012-1-20 15:13
很需要这个
作者: accesswj    时间: 2012-4-30 14:08
ookookokokkokoo
作者: xie62    时间: 2012-4-30 14:32
收下学习
作者: huanghyd    时间: 2012-11-4 15:09
学习学习
作者: epure1    时间: 2012-11-4 16:13
支持，谢谢分享
作者: mclly2000    时间: 2013-1-20 11:54
好东西
作者: euilo    时间: 2013-8-5 19:32
好东西，谢谢分享，收藏了！
作者: llxzll    时间: 2013-12-8 14:04
看看
作者: hwhwenha01    时间: 2014-4-25 19:37
学习学习学习学习学习学习
作者: hwhwenha01    时间: 2014-4-25 19:38
学习学习学习学习学习学习学习学习学习学习学习学习学习学习学习学习学习学习学习学习学习学习学习学习学习
作者: 站到终点站    时间: 2014-9-16 12:29
好东西要收藏
作者: cs20090512101    时间: 2017-6-6 20:21
ACCESS添加多个Timer功能
作者: heqing3000    时间: 2023-3-21 10:05
:):):):):):)



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3