开发者

Need to create a 30 second delay in Visual Basic 6

How can I create a 30 second delay in visual basic 6? I simply want VB6 to wait 30 seconds before moving on to t开发者_开发百科he next line of code!!


The best approach that I know of to accomplish this in VB6 is to include a call to WaitForSingleObject or some other similar Wait API function in your loop. A good example of this approach is the MsgWaitObj function written by Sergey Merzlikin (source article):

Option Explicit
'********************************************
'*    (c) 1999-2000 Sergey Merzlikin        *
'********************************************

Private Const STATUS_TIMEOUT = &H102&
Private Const INFINITE = -1& ' Infinite interval
Private Const QS_KEY = &H1&
Private Const QS_MOUSEMOVE = &H2&
Private Const QS_MOUSEBUTTON = &H4&
Private Const QS_POSTMESSAGE = &H8&
Private Const QS_TIMER = &H10&
Private Const QS_PAINT = &H20&
Private Const QS_SENDMESSAGE = &H40&
Private Const QS_HOTKEY = &H80&
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 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 Declare Function GetTickCount Lib "kernel32" () As Long

' The MsgWaitObj function replaces Sleep, 
' WaitForSingleObject, WaitForMultipleObjects functions.
' Unlike these functions, it
' doesn't block thread messages processing.
' Using instead Sleep:
'     MsgWaitObj dwMilliseconds
' Using instead WaitForSingleObject:
'     retval = MsgWaitObj(dwMilliseconds, hObj, 1&)
' Using instead WaitForMultipleObjects:
'     retval = MsgWaitObj(dwMilliseconds, hObj(0&), n),
'     where n - wait objects quantity,
'     hObj() - their handles array.

Public Function MsgWaitObj(Interval As Long, _
            Optional hObj As Long = 0&, _
            Optional nObj As Long = 0&) As Long
Dim T As Long, T1 As Long
If Interval <> INFINITE Then
    T = GetTickCount()
    On Error Resume Next
    T = T + Interval
    ' Overflow prevention
    If Err <> 0& Then
        If T > 0& Then
            T = ((T + &H80000000) _
            + Interval) + &H80000000
        Else
            T = ((T - &H80000000) _
            + Interval) - &H80000000
        End If
    End If
    On Error GoTo 0
    ' T contains now absolute time of the end of interval
Else
    T1 = INFINITE
End If
Do
    If Interval <> INFINITE Then
        T1 = GetTickCount()
        On Error Resume Next
     T1 = T - T1
        ' Overflow prevention
        If Err <> 0& Then
            If T > 0& Then
                T1 = ((T + &H80000000) _
                - (T1 - &H80000000))
            Else
                T1 = ((T - &H80000000) _
                - (T1 + &H80000000))
            End If
        End If
        On Error GoTo 0
        ' T1 contains now the remaining interval part
        If IIf((T1 Xor Interval) > 0&, _
            T1 > Interval, T1 < 0&) Then
            ' Interval expired
            ' during DoEvents
            MsgWaitObj = STATUS_TIMEOUT
            Exit Function
        End If
    End If
    ' Wait for event, interval expiration
    ' or message appearance in thread queue
    MsgWaitObj = MsgWaitForMultipleObjects(nObj, _
            hObj, 0&, T1, QS_ALLINPUT)
    ' Let's message be processed
    DoEvents
    If MsgWaitObj <> nObj Then Exit Function
    ' It was message - continue to wait
Loop
End Function


Keep in mind that the Sleep solution in @sanderd's answer will actually lock the application. In other words, all the UI pieces will be unresponsive.

If your aim is to simply prevent the control from moving on to the next line while allowing the UI to be responsive, there are other choices.

One is to loop for 30 seconds in the following manner:

' Module Level
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

' Inside a method
Dim dt as Date
dt = Now
Do While DateDiff("s", dt, now) < 30
    DoEvents
    Sleep 50   ' put your app to sleep in small increments
               ' to avoid having CPU go to 100%
Loop

This is not the most elegant way to achieve what you want but it gets the job done.


System.Threading.Thread.Sleep(30*1000) (@Moox my bad ;))

Note that calling this method in your UI-thread will hang the entire application while waiting for 30 seconds. A better alternative would be spawning a new thread for the code you want to execute.

edit:
Since your other questions are about VB6, here's a link that provides a VB6 Sleep method:
http://www.freevbcode.com/ShowCode.Asp?ID=7556


System.Threading.Thread.Sleep(100)


For the sake of a complete set of solutions:

If you're using vb6 in an application environment (like excel), you can use

Application.OnTime (now + TimeValue("00:00:30")), "ProcedurePart2"

to call a procedure (with no parameters) after 30 seconds without locking up the application or consuming CPU power.

This would, for instance, work in any VBA environment. Depending on the nature of your VB6 app (standalone vs add-on), this option may be available to you.


Put the rest of the code in a sub and then initialize a 30 second timer to call that sub. Naturally deactivate the timer before exiting.


How about this?

Public Sub delay(PauseTime as integer)
    Dim start As single
    start = Timer  
   Do While Timer < start + PauseTime
    If (Timer < start) Then 'midnight crossover
        start = start - (86400 + 1)
    End If  
    DoEvents   ' Yield to other processes.

    Loop
End Sub


I think Timer is the best solution , but there is a little modification.

The only method to disable the timer is to Raise an event to do this. Example:

 'Global Declaration
    Private event TimeReached()
    dim counter as integer

    Sub Timer_Tick () handles Timer.tick
     if counter>1 then
     RaiseEvent TimeReached  
     else
     counter+=1  
    end sub
    sub TimeHandler () handles me.TimeReached
      Timer.enabled=false
     'Code To be Processed Here           
    end sub


I tried too many different ways to make a delay , and this is the most quickest method i've ever discovered

This is a program to display message after 30 second when you click a button.

sub button1_click () handles button1.click
    Dim instance =now
    do while now.subtract(instance).seconds<30
    loop
    msgbox("30 seconds passed")
endsub  


Sub delay()
    Dim a As Integer = TimeOfDay.Second

    Do Until TimeOfDay.Second = a + 30
    Loop

End Sub
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜