pause/sleep function in VB

[HomerJS]

Is there something like a sleep or pause function in VB? I'd like to find a different way other than do a for-next loop?

Thanks.

 

[woyler]

In a module:
Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

In your form:
Sleep 3000
The above would 'pause' the app for 3 seconds

 

[sgursahaney]

HomerJS:
You can call the Win32 Sleep function directly from your VB application to make your application sleep or pause. Add the following to your Declaration section:

Public Declare Function Sleep Lib "kernel32" (ByVal SleepTime As Long) As Long

Then, simply call the function directly within your VB function/procedure as such:

Sleep 2000

Note that the Sleep function takes the amount of milliseconds to sleep as its parameter.

Regards,
Suresh

 

[CCLINT]

Public Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

Sleep 1000
[/b][/i][/u]_{*******************************************************
General remarks:
If this post contains any suggestions for the use or distribution of code, components or files of any sort, it is still your responsibility to assure that you have the proper license and distribution rights to do so!}

 

[paulbent]

Sleep pauses an application for a specified period but has the disadvantage that it pauses the thread that the application is running in, and that any window that the application has open will not repaint properly. This may present an unattractive user interface to the user. An alternative to Sleep is to use SetWaitableTimer, which will allow the screen to repaint, receive DDE messages, and so forth.

These are the declarations:

Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Public Const WAIT_ABANDONED = &H80&
Public Const WAIT_ABANDONED_0 = &H80&
Public Const WAIT_FAILED = -1&
Public Const WAIT_IO_COMPLETION = &HC0&
Public Const WAIT_OBJECT_0 = 0
Public Const WAIT_OBJECT_1 = 1
Public Const WAIT_TIMEOUT = &H102&

Public Const INFINITE = &HFFFF
Public Const ERROR_ALREADY_EXISTS = 183&

Public Const QS_HOTKEY = &H80
Public Const QS_KEY = &H1
Public Const QS_MOUSEBUTTON = &H4
Public Const QS_MOUSEMOVE = &H2
Public Const QS_PAINT = &H20
Public Const QS_POSTMESSAGE = &H8
Public Const QS_SENDMESSAGE = &H40
Public Const QS_TIMER = &H10
Public Const QS_MOUSE = (QS_MOUSEMOVE _
Or QS_MOUSEBUTTON)
Public Const QS_INPUT = (QS_MOUSE _
Or QS_KEY)
Public Const QS_ALLEVENTS = (QS_INPUT _
Or QS_POSTMESSAGE _
Or QS_TIMER _
Or QS_PAINT _
Or QS_HOTKEY)
Public 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)

Public Declare Function CreateWaitableTimer Lib "kernel32" _
Alias "CreateWaitableTimerA" ( _
Byval lpSemaphoreAttributes As Long, _
Byval bManualReset As Long, _
Byval lpName As String) As Long

Public Declare Function OpenWaitableTimer Lib "kernel32" _
Alias "OpenWaitableTimerA" ( _
Byval dwDesiredAccess As Long, _
Byval bInheritHandle As Long, _
Byval lpName As String) As Long

Public 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

Public Declare Function CancelWaitableTimer Lib "kernel32" ( _
Byval hTimer As Long) As Long

Public Declare Function CloseHandle Lib "kernel32" ( _
Byval hObject As Long) As Long

Public Declare Function WaitForSingleObject Lib "kernel32" ( _
Byval hHandle As Long, _
Byval dwMilliseconds As Long) As Long


Public 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

This sub can be called from any procedure to pause the app for the specified number of seconds:

Public Sub sWait(Byval lngNumSecs As Long)


'--- Pauses the application's process threads for a specified number of seconds
'--- Allows the screen to redraw while threads are paused


'--- Parameter
' [In]
' lngNumSecs: number of seconds to pause


Dim dblDelay As Double
Dim dblDelayLow As Double
Dim dblUnits As Double
Dim lngBusy As Long
Dim lngRtn As Long
Dim hTimer As Long
Dim strTimerName As String
Dim udtFT As FILETIME


strTimerName = "XYZ Timer" & Chr$(0)
hTimer = CreateWaitableTimer(0, True, strTimerName)


udtFT.dwLowDateTime = -1
udtFT.dwHighDateTime = -1
lngRtn = SetWaitableTimer(hTimer, udtFT, 0, 0, 0, 0)


'Convert the units to nanoseconds
dblUnits = Cdbl(&H10000) * Cdbl(&H10000)
dblDelay = Cdbl(lngNumSecs) * 1000 * 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
udtFT.dwHighDateTime = -Clng(dblDelay / dblUnits) - 1
dblDelayLow = -dblUnits * (dblDelay / dblUnits - _
Fix(dblDelay / dblUnits))

'Check we don't exceed storage capacity, H80000000 is max Long
If dblDelayLow < Cdbl(&H80000000) Then
dblDelayLow = dblUnits + dblDelayLow
End If
udtFT.dwLowDateTime = Clng(dblDelayLow)
lngRtn = SetWaitableTimer(hTimer, udtFT, 0, 0, 0, False)

Do
'QS_ALLINPUT means that MsgWaitForMultipleObjects will
'return every time the thread in which it is running gets
'a message
lngBusy = MsgWaitForMultipleObjects(1, hTimer, False, _
INFINITE, QS_ALLINPUT)
Yield
Loop Until lngBusy = WAIT_OBJECT_0

'Close the handles
CloseHandle hTimer

End Sub

Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk