Необходимо создать 30-секундную задержку в Visual Basic

Question

Как я могу создать 30-секундную задержку в Visual Basic. Я просто хочу, чтобы VB подождал 30 секунд, прежде чем перейти к следующей строке кода !!

Answer 1

Лучший из известных мне подходов для достижения этой цели в VB6 - это включить в ваш цикл вызов WaitForSingleObject или какой-либо другой подобной функции Wait API.Хорошим примером такого подхода является функция MsgWaitObj, написанная Сергеем Мерзликиным ( исходная статья ):

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

Answer 2

Имейте в виду, что решение Sleep в ответе @ sanderd фактически заблокирует приложение.Другими словами, все части пользовательского интерфейса будут не отвечать.

Если ваша цель состоит в том, чтобы просто не допустить перемещения элемента управления на следующую строку, при этом позволяя пользовательскому интерфейсу реагировать, есть другие варианты.следующим образом:

' 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

Это не самый элегантный способ добиться того, чего вы хотите, но он выполняет свою работу.

Answer 3

System.Threading.Thread.Sleep(30*1000) (@ Moox мой плохой;))

Обратите внимание, что вызов этого метода в вашем UI-потоке приведет к зависанию всего приложения в течение 30 секунд. Лучшей альтернативой было бы создание нового потока для кода, который вы хотите выполнить.

редактирование:
Поскольку другие ваши вопросы касаются VB6, вот ссылка, которая предоставляет метод VB6 Sleep:
http://www.freevbcode.com/ShowCode.Asp?ID=7556

Answer 4

System.Threading.Thread.Sleep(100)

Answer 5

Я пробовал слишком много разных способов сделать задержку, и это самый быстрый метод, который я когда-либо обнаруживал

Это программа, которая отображает сообщение через 30 секунд после нажатия кнопки.

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

Answer 6

Я думаю, что Таймер - лучшее решение, но есть небольшая модификация.

Единственный способ отключить таймер - вызвать событие, чтобы сделать это. Пример:

 '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

Answer 7

Как насчет этого?

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

Answer 8

Поместите оставшуюся часть кода в подпрограмму, а затем инициализируйте 30-секундный таймер, чтобы вызвать эту подпрограмму. Естественно отключите таймер перед выходом.

Answer 9

Ради полного набора решений:

Если вы используете vb6 в среде приложений (например, Excel), вы можете использовать

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

для вызова процедуры (без параметров) через 30 секунд без блокировки приложения или использования ресурсов процессора.

Это, например, будет работать в любой среде VBA.В зависимости от характера вашего приложения VB6 (автономный или надстройка) этот параметр может быть доступен для вас.

Answer 10

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

    Do Until TimeOfDay.Second = a + 30
    Loop

End Sub