分享：不会让窗口失去响应、不太占CPU的延时模块

[「已注销」]

Option Explicit

'2009-10-15
'延时模块(不会让窗口失去响应，不太占CPU)
'调用方式：Yanshi(300)，即延时300毫秒。
'本模块参考了某个类模块，那个类模块里的代码我理解得不透彻，就精简了一下写了本模块，没想到
'也能用，暂时没发现问题。

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Declare Function CreateWaitableTimer Lib "kernel32" Alias "CreateWaitableTimerA" (ByVal lpSemaphoreAttributes As Long, ByVal bManualReset As Long, ByVal lpName As String) As Long
Private Declare Function SetWaitableTimer Lib "kernel32" (ByVal Htimer As Long, lpDueTime As FILETIME, ByVal lPeriod As Long, ByVal pfnCompletionRoutine As Long, ByVal lpArgToCompletionRoutine As Long, ByVal fResume As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function MsgWaitForMultipleObjects Lib "user32" (ByVal nCount As Long, pHandles As Long, ByVal fWaitAll As Long, ByVal dwMilliseconds As Long, ByVal dwWakeMask As Long) As Long

Private Const WAIT_OBJECT_0 = 0
Private Const INFINITE = &HFFFF    '无限超时(Infinite timeout)
Private Const QS_HOTKEY& = &H80
Private Const QS_KEY& = &H1
Private Const QS_MOUSEBUTTON& = &H4
Private Const QS_MOUSEMOVE& = &H2
Private Const QS_PAINT& = &H20
Private Const QS_POSTMESSAGE& = &H8
Private Const QS_SENDMESSAGE& = &H40
Private Const QS_TIMER& = &H10
Private Const QS_MOUSE& = (QS_MOUSEMOVE Or QS_MOUSEBUTTON)
Private Const QS_INPUT& = (QS_MOUSE Or QS_KEY)
Private Const QS_ALLEVENTS& = (QS_INPUT Or QS_POSTMESSAGE Or QS_TIMER Or QS_PAINT Or QS_HOTKEY)
Private Const QS_ALLINPUT& = (QS_SENDMESSAGE Or QS_PAINT Or QS_TIMER Or QS_POSTMESSAGE Or QS_MOUSEBUTTON Or QS_MOUSEMOVE Or QS_HOTKEY Or QS_KEY)

Public Sub Yanshi(MilliSeconds As Long)
    On Error GoTo Cuo:
Dim Htimer As Long, WenjianTime As FILETIME, Ret As Long
    'Htimer是计时器句柄

    If Htimer <> 0 Then CloseHandle Htimer
    Htimer = CreateWaitableTimer(0, True, "Timer" & Format(Now, "hhmmnn"))
    'CreateWaitableTimer创建一个可等待的计时器对象，返回值：Long，如执行成功，返回可等待
    '计时器对象的句柄；零表示出错。参数lpSemaphoreAttributes As SECURITY_ATTRIBUTES
    '指定一个结构，用于设置对象的安全特性。如将参数声明为ByVal As Long，并传递零值，
    '就可使用对象的默认安全设置。bManualReset As Long，如果为TRUE，表示创建一个人工重设计时器；
    '如果为FALSE，则创建一个自动重设计时器。lpName As String，指定可等待计时器对象的名称。
    If Htimer = 0 Then
        Debug.Print "调用CreateWaitableTimer失败"
        Exit Sub
    End If
    WenjianTime.dwHighDateTime = -1
    WenjianTime.dwLowDateTime = -(MilliSeconds * 10000)
    Ret = SetWaitableTimer(Htimer, WenjianTime, 0, 0, 0, 0)
    'SetWaitableTimer启动一个可等待计时器，将它设为未发信号状态。返回值 As Long，非零表示成功，
    '零表示失败。hTimer As Long，指定一个可等待计时器的句柄。lpDueTime As FILETIME，指定
    '一个包含了64位时间值的结构。如果为正，它代表计时器要触发的时间。如果为负，它代表自
    '函数调用以来持续的时间。时间是以100ns为单位指定的。lPeriod As Long，如果为零，这个计时器
    '只会触发一次。否则，计时器会根据这里设置的持续时间自动重新启动(以毫秒为单位指定)。
    'pfnCompletionRoutine As Long，指定零或者计时器触发时要调用的一个函数的地址。可在标准
    '模块中用一个函数通过AddressOf操作符提供这个地址。或者使用此类ocx控件。最终的例程采取下述形式：
    'Sub myfunc(ByVal lpArgToCompletion&, ByVal dwTimerLow&, ByVal dwTimerHigh&)
    'lpArgToCompletionRoutine As Long，传递给最终例程的值。fResume As Long，如果为TRUE，
    '而且系统支持电源管理，那么在计时器触发的时候，系统会退出省电模式。如设为TRUE，但系统不
    '支持省电模式，GetLastError就会返回ERROR_NOT_SUPPORTED。
    '至于WenjianTime的dwHighDateTime和dwLowDateTime，dwHighDateTime设为-1，
    'dwLowDateTime设为-(延时时间*10000)，因为要转换单位，所以要*10000。至于为什么是负的，
    '请看此句：如果为正，它代表计时器要触发的时间。如果为负，它代表自函数调用以来持续的时间。
    '时间是以100ns为单位指定的。后面4个参数都填0。
    If Ret = 0 Then
        Debug.Print "调用SetWaitableTimer失败"
        CloseHandle Htimer
        Exit Sub
    End If
    Do
        Ret = MsgWaitForMultipleObjects(1, Htimer, False, INFINITE, QS_ALLINPUT)
        '等候计时器发出信号
        DoEvents
    Loop Until Ret = WAIT_OBJECT_0
    'MsgWaitForMultipleObjects等候单个对象或一系列对象发出信号，标志着规定的超时已经过去，
    '或特定类型的消息已抵达线程的输入队列。如返回条件已经满足，则立即返回。返回WAIT_OBJECT_0
    '意思是所有的对象都发出信号。参数：nCount，指定列表中的句柄数量。pHandles，指定对象句柄
    '组合中的第一个元素。fWaitAll，如果为TRUE，表示除非对象同时发出信号，否则就等待下去。
    '如果为FALSE，表示任何对象发出信号即可。dwMilliseconds，指定要等待的毫秒数，填INFINITE
    '表示无限等待。dwWakeMask，带有QS_??前缀的一个或多个常数，用于标识特定的消息类型。
    '如果用WaitForSingleObject函数就会导致窗口失去响应，所以本例用MsgWaitForMultipleObjects函数。
    '一旦不再需要，一定记住用CloseHandle关闭计时器对象的句柄。它的所有句柄都关闭以后，
    '对象自己也会删除。
    CloseHandle Htimer
    Htimer = 0

    Exit Sub
Cuo:
    CloseHandle Htimer

End Sub

[「已注销」]

阅读次数15？哎～再等一等，明天结贴吧。

[Flyingdragon168]

謝謝樓主。

[jhone99]

支持分享,谢谢

[jhone99]

[Quote=引用 3 楼 p7a41679d 的回复:]
阅读次数15？哎～再等一等，明天结贴吧。
[/Quote]

现在结贴，好多人看不到，可惜了，放几天吧

[贝隆]

学习了！

[getemail]

从哪看到阅读次数的？
[Quote=引用 3 楼 p7a41679d 的回复:]
阅读次数15？哎～再等一等，明天结贴吧。
[/Quote]

[「已注销」]

看阅读次数的方法：如果是自己发的帖子，点击管理菜单旁边的结贴。可以从自己提问的下面看到阅读次数。

[getemail]

学了一招，谢谢LZ

[Like_328]

顶,接分

[舉杯邀明月]

谢谢楼主！

[DengXingJie]

支持分享、支持散分

[yangbo_cuit]

好东西

[LCAAA]

学习了。。。。

[嗷嗷叫的老马]

直接用这样的代码去断掉语句执行,是常用的办法.我也有一个常用的思路,与大家交流一下.

如果我要做一系列的操作,其中有延时需求,我首选的方案是尝试将整个操作以延时需求来分段,然后各自写到不同的子程序里,再由定时器+执行状态变量来确定什么时候该延时多少,以及应该调用什么子程序.

缺点是,代码可能会有些不好控制结构............

[jhone99]

顶 顶 [size=72px]顶[/size] [size=100px]顶[/size] [size=144px]顶[/size] [size=99px]顶[/size]

[孤独剑_LPZ]

昨天升级上不去csdn,支持lz

[wing013]

都是星星人

[womouth]

好东西！顶

[现在还是人类]

[Quote=引用 12 楼 myjian 的回复:]
直接用这样的代码去断掉语句执行,是常用的办法.我也有一个常用的思路,与大家交流一下.

如果我要做一系列的操作,其中有延时需求,我首选的方案是尝试将整个操作以延时需求来分段,然后各自写到不同的子程序里,再由定时器+执行状态变量来确定什么时候该延时多少,以及应该调用什么子程序.

缺点是,代码可能会有些不好控制结构............
[/Quote]

老马的思路有点像执行解码中的队列，但对于这个概念要做到效果很好就不那么容易了

[zhangsl02]

必须支持一下 太感谢了