VisualBasicで30秒の遅延を作成するにはどうすればよいですか。 VB 30秒待ってから、次のコード行に移動したいだけです!!
VB6でこれを実現するために私が知っている最善のアプローチは、WaitForSingleObjectまたは他の同様のWaitAPI関数の呼び出しをループに含めることです。このアプローチの良い例は、Sergey Merzlikinによって書かれた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
@sanderdの回答の Sleep ソリューションは、実際にはアプリケーションをロックすることに注意してください。つまり、すべてのUI部分が応答しなくなります。
UIの応答性を維持しながら、コントロールが次の行に移動しないようにすることが目的の場合は、他の選択肢があります。
1つは、次の方法で30秒間ループすることです。
' 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
これはあなたが望むことを達成するための最もエレガントな方法ではありませんが、それは仕事を成し遂げます。
System.Threading.Thread.Sleep(30*1000)
(@ Moox my bad;))
UIスレッドでこのメソッドを呼び出すと、30秒間待機している間にアプリケーション全体がハングすることに注意してください。より良い代替策は、実行したいコードの新しいスレッドを生成することです。
編集:
他の質問はVB6に関するものなので、VB6スリープメソッドを提供するリンクは次のとおりです。
http://www.freevbcode.com/ShowCode.Asp?ID=7556
System.Threading.Thread.Sleep(100)
残りのコードをサブに入れてから、30秒のタイマーを初期化してそのサブを呼び出します。終了する前に、当然タイマーを無効にします。
私は遅延を作るためにあまりにも多くの異なる方法を試しました、そしてこれは私が今まで発見した中で最も速い方法です
ボタンをクリックすると30秒後にメッセージを表示するプログラムです。
sub button1_click () handles button1.click
Dim instance =now
do while now.subtract(instance).seconds<30
loop
msgbox("30 seconds passed")
endsub
タイマーが最善の解決策だと思いますが、少し変更があります。
タイマーを無効にする唯一の方法は、これを行うためにイベントを発生させることです。例:
'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
これはどう?
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
ソリューションの完全なセットのために:
アプリケーション環境(Excelなど)でvb6を使用している場合は、次を使用できます。
Application.OnTime (now + TimeValue("00:00:30")), "ProcedurePart2"
アプリケーションをロックしたりCPUパワーを消費したりせずに、30秒後にプロシージャ(パラメータなし)を呼び出す。
これは、たとえば、どのVBA環境でも機能します。 VB6アプリの性質(スタンドアロンとアドオン)によっては、このオプションを利用できる場合があります。
Sub delay()
Dim a As Integer = TimeOfDay.Second
Do Until TimeOfDay.Second = a + 30
Loop
End Sub