当前位置:编程学习 > VB >>

【求助】使用Exit Sub来延时,可行不?

--------------------编程问答-------------------- 不行
Timer.enable = True '打开计时器
    While mywait = false
         Exit sub 
    Wend
  直接执行,不会等待
   Timer.enable = False '关闭计时器
--------------------编程问答-------------------- 楼上的朋友,是啥子意思哦。。。。 --------------------编程问答-------------------- 查了下资料,说exit sub是退出过程,难道就直接退出这个循环的过程。天啊!
VB中有没一个语句是什么都不干的,就是在等待的呀。
别说doevents, 看到CPU100%我就难受
别说SLEEP(), 把窗体卡死了,我也难受

各位有偶啥子建议么。 --------------------编程问答-------------------- '示例:可动延时.

'增加一个工程,一个窗口.窗口中一个按扭
' 以下代码在窗体中

' Download:    http://www.codefans.net
Option Explicit


Private Sub cmdWaitTimer_Click() '按扭的名称改一下.
    Dim objTimer As clsWaitableTimer
    Set objTimer = New clsWaitableTimer
    
    cmdWaitTimer.Enabled = False
    MsgBox "1"
    objTimer.Wait 5000  '5 秒
    MsgBox "2"
    cmdWaitTimer.Enabled = True
    Set objTimer = Nothing
End Sub



'****************************
'增加一个类模块.类名: clsWaitableTimer
'以下代码在类中
'**************************************
' Name:        clsWaitableTimer
'
' Description: This class encapsulate the WaitableTimer API functions to
'              put the thread of your application to Sleep for a period of time.
'              The benefit of a Waitable timer to the Sleep API is that your
'              application will still be responsive to events, where Sleep
'              will freeze your application for the set interval.
' Download:    http://www.codefans.net
' Example:     'This is an example for idling your application
'              Private mobjWaitTimer As clsWaitableTimer
'              Private Sub RunProcess()
'                Set mobjWaitTimer = New clsWaitableTimer
'                Do
'                 If mbWorkToDo Then
'                   Call ProcessWork()
'                 Else
'                   mobjWaitTimer.Wait(5000) 'Wait for 5 seconds
'                 End If
'                Loop Until Not mbStop
'                Set mobjWaitTimer = nothing
'              End Sub
'
' Revision History:

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Const WAIT_ABANDONED& = &H80&
Private Const WAIT_ABANDONED_0& = &H80&
Private Const WAIT_FAILED& = -1&
Private Const WAIT_IO_COMPLETION& = &HC0&
Private Const WAIT_OBJECT_0& = 0
Private Const WAIT_OBJECT_1& = 1
Private Const WAIT_TIMEOUT& = &H102&
Private Const INFINITE = &HFFFF
Private Const ERROR_ALREADY_EXISTS = 183&
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)

Private Const UNITS = 4294967296#
Private Const MAX_LONG = -2147483648#

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 OpenWaitableTimer Lib "kernel32" Alias "OpenWaitableTimerA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle 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 CancelWaitableTimer Lib "kernel32" (ByVal hTimer 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 mlTimer As Long

Private Sub Class_Terminate()
    On Error Resume Next
    If mlTimer <> 0 Then CloseHandle mlTimer
End Sub

Public Sub Wait(MilliSeconds As Long)
    On Error GoTo ErrHandler
    Dim ft As FILETIME
    Dim lBusy As Long
    Dim lRet As Long
    Dim dblDelay As Double
    Dim dblDelayLow As Double
    
    mlTimer = CreateWaitableTimer(0, True, App.EXEName & "Timer" & Format$(Now(), "NNSS"))
    
    If Err.LastDllError <> ERROR_ALREADY_EXISTS Then
        ft.dwLowDateTime = -1
        ft.dwHighDateTime = -1
        lRet = SetWaitableTimer(mlTimer, ft, 0, 0, 0, 0)
    End If
    
    ' Convert the Units to nanoseconds.
    dblDelay = CDbl(MilliSeconds) * 10000#
    
    ' By setting the high/low time to a negative number, it tells
    ' the Wait (in SetWaitableTimer) to use an offset time as
    ' opposed to a hardcoded time. If it were positive, it would
    ' try to convert the value to GMT.
    ft.dwHighDateTime = -CLng(dblDelay / UNITS) - 1
    dblDelayLow = -UNITS * (dblDelay / UNITS - Fix(CStr(dblDelay / UNITS)))
    
    If dblDelayLow < MAX_LONG Then dblDelayLow = UNITS + dblDelayLow
    
    ft.dwLowDateTime = CLng(dblDelayLow)
    lRet = SetWaitableTimer(mlTimer, ft, 0, 0, 0, False)
    
    Do
        ' QS_ALLINPUT means that MsgWaitForMultipleObjects will
        ' return every time the thread in which it is running gets
        ' a message. If you wanted to handle messages in here you could,
        ' but by calling Doevents you are letting DefWindowProc
        ' do its normal windows message handling---Like DDE, etc.
        lBusy = MsgWaitForMultipleObjects(1, mlTimer, False, INFINITE, QS_ALLINPUT&)
        DoEvents
    Loop Until lBusy = WAIT_OBJECT_0
    
    ' Close the handles when you are done with them.
    CloseHandle mlTimer
    mlTimer = 0
    Exit Sub
    
ErrHandler:
    Err.Raise Err.Number, Err.Source, "[clsWaitableTimer.Wait]" & Err.Description
End Sub



--------------------编程问答-------------------- 。。。这个。。。也太长了吧 --------------------编程问答-------------------- 把你处理的代码分离出来

可以用你顶楼的办法

用timer后,重新运行后面的代码就可以了 --------------------编程问答-------------------- 这个doevents怎么会CPU100%,应该是你没用对吧。 --------------------编程问答-------------------- doevents会CPU100%?我经常用啊,怎么没发现
不过我从来不知道doevents居然可用来延时 --------------------编程问答-------------------- 不是doevents会造成cpu占用100%,而是你while wend语句会不停的执行在循环中的语句,如果循环中的语句比较耗费CPU执行周期,那么肯定CPU占用率就100%,而延时sleep函数最大的好处就是它基本不会耗费始终周期,但是会造成假死现象.
你在循环中直接用exit sub那好象就直接退出cmd这个过程了吧.你做循环等待也许可以试试下面这样,应该不会假死,也不会占用100%了.

private sub cmd()

While
   XXXXXXXXXXXX 这个地方是程序执行的地方,省略N个字
   '下面是关键的延时开始了
    Timer.enable = True '打开计时器
    While mywait = false
         doevents '//可以响应事件,防止假死
          sleep(5)'//防止CPU占用100%
    Wend
   Timer.enable = False '关闭计时器
 Wend

end sub

--------------------编程问答-------------------- sleep --------------------编程问答-------------------- 谢谢,我昨晚确实有试这个方法,感觉一般,不过我的SLEEP (1)CPU还是100%,不过情况好了些 , 今晚尝试设置为 SLEEP (5)吧。
我一直以为是DOEVENTS搞的我CPU100%啊,原来是那个WHILE循环整的啊。。。汗。
SLEEP这个我实在没好感。。。

引用 9 楼 sulipeng007 的回复:
不是doevents会造成cpu占用100%,而是你while wend语句会不停的执行在循环中的语句,如果循环中的语句比较耗费CPU执行周期,那么肯定CPU占用率就100%,而延时sleep函数最大的好处就是它基本不会耗费始终周期,但是会造成假死现象.
你在循环中直接用exit sub那好象就直接退出cmd这个过程了吧.你做循环等待也许可以试试下面这样,应该不会假死,也不会占用100%了.
VB codeprivatesub cmd()While
   XXXXXXXXXXXX 这个地方是程序执行的地方,省略N个字'下面是关键的延时开始了Timer.enable=True'打开计时器While mywait=false
         doevents'//可以响应事件,防止假死          sleep(5)'//防止CPU占用100%WendTimer.enable=False'关闭计时器Wendend sub
--------------------编程问答-------------------- 9楼的方法好,我也常用这个方法,可以起到延时,CPU也不会占用100% --------------------编程问答-------------------- .....路过. --------------------编程问答-------------------- '时间延时
Public Declare Function GetTickCount Lib "Kernel32" () As Long
Public Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Public Sub Delay(mmSec As Long)
    Dim Start As Long
    Start = GetTickCount()
    Do While Abs(GetTickCount - Start) <= mmSec
        DoEvents
        Sleep (1)
    Loop
End Sub

这个函数可以延时,而且绝对不占用CPU.使用Doevent跟Sleep(1)就是控制每1毫秒释放一个挂起操作,可以完全避免程序不动的情况,注意,sleep(value) 中的,value值越大,就越容易挂起.
我们公司的生产控制系统就是用这个函数延时的.我试验了很多次,这个效果最佳.
当然如果是多线程的话,就另当别论了. --------------------编程问答-------------------- '时间延时 
Public Declare Function GetTickCount Lib "Kernel32" () As Long 
Public Sub Delay(mmSec As Long) 
    Dim Start As Long 
    Start = GetTickCount() 
    Do While Abs(GetTickCount - Start) <= mmSec 
        DoEvents 
    Loop 
End Sub 
这样延时最好,我一直使用。 --------------------编程问答-------------------- 0.5S以上的延时比较准。0.1S级别的延时实现很麻烦
补充:VB ,  基础类
CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,