SKY外语计算机学习

标题: vb中关于延时的方法 [打印本页]
作者: SKY定格    时间: 2012-6-6 19:10
标题: vb中关于延时的方法
本帖最后由 sky_yx 于 2015-12-30 14:19 编辑

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

作者: SKY定格    时间: 2012-6-6 20:56
本帖最后由 sky_yx 于 2015-12-30 14:19 编辑

写了个函数  延时还不错 调用 方法 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定格    时间: 2012-6-7 19:26
本帖最后由 sky_yx 于 2015-12-30 14:19 编辑

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

  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    时间: 2013-11-22 09:48
本帖最后由 sky_yx 于 2015-12-30 14:19 编辑

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

作者: 184504762    时间: 2013-11-22 09:49
本帖最后由 sky_yx 于 2015-12-30 14:19 编辑

你等级都那么高了  





欢迎光临 SKY外语计算机学习 (http://www.skywj.com/) Powered by Discuz! X2.5