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
精彩评论