how to make program sleep????

[ghobbes98]

I was trying to make my program sleep for a certain numer of milliseconds.
What is the exact way of achieving this
thanks for any help
G

 

[Foada]

Add the following api

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Anything is possible, the problem is I only have one lifetime.

 

[paulbent]

SetWaitableTimer is better than Sleep because the app can respond to screen updates if its window is resized while the app is paused.

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 app'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 = "My App 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

 

[ghobbes98]

thanks paul bu that is just a bit more then is actually needed at the moment. It is a formless program so I don't need it to check if the window has been resized. Thanks very much though.
G