vb中关于延时的方法

SKY定格

有时候程序中 一句代码执行完毕后不需要立即执行下一句代码 中间需要延时 比如 模拟按键再按下和弹起中间加一个0.1秒的延时  再或者需要一个小动画 帧与帧之间也需要一个延时 用到的地方还有很多
我一般延时使用的是
    Dim t As Single
    t = Timer
    Do While Timer - t < 0.1
        DoEvents
    Loop
这样来达到延时的目的  不过貌似系统资源会使用的很多我上次一个循环的判断 中间加了一个延时 电脑cpu直接50%了
还有使用api sleep延时   这时候线程会被挂起来饿、、 vb这个单线程挂起来了可想而知，，直接无响应了
最后我还使用过timer控件来达到延时的目的 不过就是太麻烦了饿。。。
能不能就想易语言里面的延时一样即能延时又不会无响应 而且不会过分的占用系统资源呢？  求各位大牛详解 不胜感激

SKY定格

写了个函数  延时还不错 调用 方法 s 毫秒

1. Public Function s(ByVal timer As Long)
   
2.     t = timer / 10
   
3.     For i = 1 To t
   
4.         DoEvents
   
5.         Sleep (10)
   
6.     Next i
   
7. End Function

复制代码

SKY定格

用这个 类 很不错 cpu 占用“基本”没有   也没有假死

1. 
   
2. Option Explicit
   
3. Private Type FILETIME
   
4. dwLowDateTime As Long
   
5. dwHighDateTime As Long
   
6. End Type
   
7. Private Const WAIT_ABANDONED& = &H80&
   
8. Private Const WAIT_ABANDONED_0& = &H80&
   
9. Private Const WAIT_FAILED& = -1&
   
10. Private Const WAIT_IO_COMPLETION& = &HC0&
    
11. Private Const WAIT_OBJECT_0& = 0
    
12. Private Const WAIT_OBJECT_1& = 1
    
13. Private Const WAIT_TIMEOUT& = &H102&
    
14. Private Const INFINITE = &HFFFF
    
15. Private Const ERROR_ALREADY_EXISTS = 183&
    
16. Private Const QS_HOTKEY& = &H80
    
17. Private Const QS_KEY& = &H1
    
18. Private Const QS_MOUSEBUTTON& = &H4
    
19. Private Const QS_MOUSEMOVE& = &H2
    
20. Private Const QS_PAINT& = &H20
    
21. Private Const QS_POSTMESSAGE& = &H8
    
22. Private Const QS_SENDMESSAGE& = &H40
    
23. Private Const QS_TIMER& = &H10
    
24. Private Const QS_MOUSE& = (QS_MOUSEMOVE Or QS_MOUSEBUTTON)
    
25. Private Const QS_INPUT& = (QS_MOUSE Or QS_KEY)
    
26. Private Const QS_ALLEVENTS& = (QS_INPUT Or QS_POSTMESSAGE Or QS_TIMER Or QS_PAINT Or QS_HOTKEY)
    
27. 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)
    
28. Private Const UNITS = 4294967296#
    
29. Private Const MAX_LONG = -2147483648#
    
30. Private Declare Function CreateWaitableTimer _
    
31. Lib "kernel32" _
    
32. Alias "CreateWaitableTimerA" (ByVal lpSemaphoreAttributes As Long, _
    
33. ByVal bManualReset As Long, _
    
34. ByVal lpName As String) As Long
    
35. Private Declare Function OpenWaitableTimer _
    
36. Lib "kernel32" _
    
37. Alias "OpenWaitableTimerA" (ByVal dwDesiredAccess As Long, _
    
38. ByVal bInheritHandle As Long, _
    
39. ByVal lpName As String) As Long
    
40. Private Declare Function SetWaitableTimer _
    
41. Lib "kernel32" (ByVal hTimer As Long, _
    
42. lpDueTime As FILETIME, _
    
43. ByVal lPeriod As Long, _
    
44. ByVal pfnCompletionRoutine As Long, _
    
45. ByVal lpArgToCompletionRoutine As Long, _
    
46. ByVal fResume As Long) As Long
    
47. Private Declare Function CancelWaitableTimer Lib "kernel32" (ByVal hTimer As Long)
    
48. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    
49. Private Declare Function WaitForSingleObject _
    
50. Lib "kernel32" (ByVal hHandle As Long, _
    
51. ByVal dwMilliseconds As Long) As Long
    
52. Private Declare Function MsgWaitForMultipleObjects _
    
53. Lib "user32" (ByVal nCount As Long, _
    
54. pHandles As Long, _
    
55. ByVal fWaitAll As Long, _
    
56. ByVal dwMilliseconds As Long, _
    
57. ByVal dwWakeMask As Long) As Long
    
58. Private mlTimer As Long
    
59. Private Sub Class_Terminate()
    
60.     On Error Resume Next
    
61.     If mlTimer <> 0 Then CloseHandle mlTimer
    
62. End Sub
    
63. Public Sub Wait(MilliSeconds As Long)
    
64.     On Error GoTo ErrHandler
    
65. Dim ft As FILETIME
    
66. Dim lBusy As Long
    
67. Dim lRet As Long
    
68. Dim dblDelay As Double
    
69. Dim dblDelayLow As Double
    
70. mlTimer = CreateWaitableTimer(0, True, App.EXEName & "Timer" & Format$(Now(), "NNSS"))
    
71. If Err.LastDllError <> ERROR_ALREADY_EXISTS Then
    
72. ft.dwLowDateTime = -1
    
73. ft.dwHighDateTime = -1
    
74. lRet = SetWaitableTimer(mlTimer, ft, 0, 0, 0, 0)
    
75. End If
    
76. dblDelay = CDbl(MilliSeconds) * 10000#
    
77. ft.dwHighDateTime = -CLng(dblDelay / UNITS) - 1
    
78. dblDelayLow = -UNITS * (dblDelay / UNITS - Fix(CStr(dblDelay / UNITS)))
    
79. If dblDelayLow < MAX_LONG Then dblDelayLow = UNITS + dblDelayLow
    
80. ft.dwLowDateTime = CLng(dblDelayLow)
    
81. lRet = SetWaitableTimer(mlTimer, ft, 0, 0, 0, False)
    
82. Do
    
83. lBusy = MsgWaitForMultipleObjects(1, mlTimer, False, INFINITE, QS_ALLINPUT&)
    
84. DoEvents
    
85. Loop Until lBusy = WAIT_OBJECT_0
    
86. CloseHandle mlTimer
    
87. mlTimer = 0
    
88. Exit Sub
    
89. ErrHandler:
    
90. Err.Raise Err.Number, Err.Source, "[clsWaitableTimer.Wait]" & Err.Description
    
91. End Sub
    

复制代码

184504762

哈哈,厉害,我以前 sleep 1  这样基本看不出假死

184504762

你等级都那么高了