How to make a Delay ??? H...E...L...P

[Yovav]

How can I use stop for couple seconds ?

I DO NOT want use a loop (that will kill CPU time)

10X - Please Help



··(Tip): 2 get code from this page - first paste it in2 FrontPage and then in2 NotePad...
··
··Best Regards - Yovav Gad
··EMail: Development@SuperMain.com
··Web-Site: http://www.SuperMain.com

[John G Duffy]

Here is a simple sample program that puts your APp to sleep for a determinate amount of time

' General declaration section
option Explicit
private Declare Sub sleep Lib "Kernel32" Alias "Sleep" ( _
byval dwMilliseconds as Long)

private Sub Command1_Click()
Picture1.Cls
Picture1.print now " sleeping for 10 seconds"
sleep (10000)
Picture1.print now " Sleep finished"
End Sub




John G

[Yovav]

10X,

Must I put this decleration line in a NEW module ?
or is there a way of using in from my form ?

··(Tip): 2 get code from this page - first paste it in2 FrontPage and then in2 NotePad...
··
··Best Regards - Yovav Gad
··EMail: Development@SuperMain.com
··Web-Site: http://www.SuperMain.com

[Boumxyz2]

In comments he wrote General declaration section so that means you can declare it in the form scope. But if you want to use it in multiple forms you can declare it in a module or declare it in each forms.

[John G Duffy]

Use the Declare as is in a Form. If you want to use it in more than one form, you will need to change the Private to Public and add it to a module somewhere. If you want to use it in a subroutine that is in a module, then it also has to be installed in a module with Public instead of Private

John G

[Clearcode]

The thing with using the Sleep API call is that it totally suspends execution of the current thread until it returns.
Since VB has all its operations on a single thread this means that window refreshing etc. will be suspended while the sleep is ongoing so it will look like your application has crashed.
A better way is to have a DoEvents loop and disable your application's form to prevent anything being clicked while it is "Asleep".

e.g.

public Sub SleepForm(byval frmIn as Form, byval nSeconds as Long)

Dim dtRestart as date

frmIn.Enabled = false
dtRestart = DateAdd("s",nSeconds, Now)

While Now < dtRestart
DoEvents
Wend

frmIn.Enabled = true

End Sub




HTH,
Duncan

-------------------------------------------------
Ex. Datis: Duncan Jones
Merrion Computing Ltd
http://www.merrioncomputing.com
Check out the new downloads - ImageMap.ocx is the VB control that emulates an HTML image map, EventVB.OCX for adding new events to your VB form and adding System Tray support simply, MCL Hotkey for implemenmting system-wide hotkeys in your application...all with source code included.

[John G Duffy]

Duncan Jones (ClearCode) rightly pointed out that my sample will freeze your app for the specified time.
If this is unacceptable, then you need to use a Waitable timer which does not.
Here is a sample using a .cls module.
1).Start a new project
2). add a class module to it (Name it clsWaitableTimer)
3). Add two command buttons to the form. Name them cmdSleep and cmdWaitTimer
4). paste this code as appropriate
5). Run the program
This program actually is a comparison between the Waitable Timer method and the Sleep method.
Once you punch the Sleep command button nothing else can be done until the time expires.
This is untrue of the WaitTimer button

'
' Paste this code into the Form
'
option Explicit

private Declare Sub Sleep Lib "kernel32" (byval dwMilliseconds as Long)

private Sub cmdWaitTimer_Click()
Dim objTimer as clsWaitableTimer
set objTimer = new clsWaitableTimer

cmdWaitTimer.Enabled = false
objTimer.Wait 5000 '5 seconds
cmdWaitTimer.Enabled = true
set objTimer = nothing
End Sub

private Sub cmdSleep_Click()
cmdSleep.Enabled = false
Sleep 5000 '5 seconds
cmdSleep.Enabled = true
End Sub

private Sub Form_Load()
With frmTimerTest
.Height = 1400
.Width = 2400
.Caption = "Test Timer"
End With
With cmdWaitTimer
.Move 100, 100, 2000, 300
.Caption = "SetWaitableTimer"
.Enabled = true
End With
With cmdSleep
.Move 100, 500, 2000, 300
.Caption = "Sleep"
.Enabled = true
End With
End Sub

'
'
' paste this code in the class module .
'
option Explicit
'**************************************
' 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.
'
' 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





John G