VB 可以用DoEvents解決
一般來說 轉成C++就是用 Application->ProcessMessages
但既然魔王說無法達到效果
可能就要用多執行續 (另一個執行續專職檢查結束條件)
或模擬VB裡的 Timer物件 (每xx ms檢查一次)
mini用VB就非常喜歡Timer物件
BCB好像也有 Timer物件可用...
如都不行
那迴圈 可以試試用 Win API的 MsgWaitForMultipleObjects、SetWaitableTimer...等來架構
以下是 VB6時期用的 高精密度 wait函式
PHP 語法:
'****************
'* 計時模組 *
'****************
Option Explicit
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
'lpSemaphoreAttributes As SECURITY_ATTRIBUTES
Private Declare Function CreateWaitableTimer Lib "kernel32" Alias "CreateWaitableTimerA" ( _
ByVal lpSemaphoreAttributes As Long, _
ByVal bManualReset As Long, _
ByVal lpName As String) As Long
'==說明==
'創建一個可等待的計時器對像
'==返回值==
'Long，如執行成功，返回可等待計時器對象的句柄；零表示出錯。
'會設置GetLastError。即使返回一個有效的句柄，但倘若它指出同名的一個計時器對像已經存在，
'那麼GetLastError也會返回ERROR_ALREADY_EXISTS
'==參數表==
'參數 類型 及說明
'lpSemaphoreAttributes SECURITY_ATTRIBUTES ，指定一個結構，用於設置對象的安全特性。如將參數聲明為ByVal As Long，並傳遞零值，就可使用對象的默認安全設置
'bManualReset Long ，如果為TRUE，表示創建一個人工重設計時器；如果為FALSE，則創建一個自動重設計時器
'lpName String ，指定可等待計時器對象的名稱。用vbNullString可創建一個未命名的計時器對象。如果已經存在擁有這個名字的一個可等待計時器，就直接打開現成的可等待計時器。這個名字可能不與一個現有的互斥體、事件、信號機或文件映射的名稱相符
'==註解==
'一旦不再需要，一定記住用CloseHandle關閉計時器對象的句柄。
'它的所有句柄都關閉以後，對像自己也會刪除
Private Declare Function CancelWaitableTimer Lib "kernel32" (ByVal hTimer As Long)
'==說明==
'這個函數用於取消一個可以等待下去的計時器操作。
'計時器保持它當前的狀態，而且除非用SetWaitableTimer函數明確啟動，否則它不會重新啟動
'==返回值==
'Long，非零表示成功，零表示失敗。會設置GetLastError
''==參數表==
'參數 類型及說明
'hTimer Long ，可等待計時器的句柄
'==適用平台==
'Windows NT
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
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
'==說明==
'啟動一個可等待計時器。將它設為未發信號狀態
'==返回值==
'Long，非零表示成功，零表示失敗。會設置GetLastError
'==參數表==
'參數 類型及說明
'hTimer Long，指定一個可等待計時器的句柄
'lpDueTime FILETIME，指定一個包含了64位時間值的結構。如果為正，它代表計時器要觸發的時間。如果為負，它代表自函數調用以來持續的時間。時間是以100ns為單位指定的
'lPeriod Long，如果為零，這個計時器只會觸發一次。否則，計時器會根據這裡設置的持續時間自動重新啟動（以毫秒為單位指定）
'pfnCompletionRoutine Long，指定零或者計時器觸發時要調用的一個函數的地址。可在標準模塊中用一個函數通過AddressOf操作符提供這個地址。或者使用此類ocx控件。
' 最終的例程採取下述形式： Sub myfunc(ByVal lpArgToCompletion&, ByVal dwTimerLow&, ByVal dwTimerHigh&)
'lpArgToCompletionRoutine Long，傳遞給最終例程的值
'fResume Long，如果為TRUE，而且系統支持電源管理，那麼在計時器觸發的時候，系統會退出省電模式。如設為TRUE，但系統不支持省電模式，GetLastError就會返回ERROR_NOT_SUPPORTED
'==適用平台==
'Windows NT
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'==說明==
'關閉一個內核對象。其中包括文件、文件映射、進程、執行緒、安全和同步對像等。
'涉及文件處理時，這個函數通常與vb的close命令相似。
'應盡可能的使用close，因為它支持vb的差錯控制。
'注意這個函數使用的文件句柄與vb的文件編號是完全不同的
'==返回值==
'Long，非零表示成功，零表示失敗。會設置GetLastError
'==參數表==
'參數 類型 及說明
'hObject 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
'==說明==
'等候單個對象或一系列對像發出信號---標誌著規定的超時已經過去，
'或特定類型的消息已抵達執行緒的輸入隊列。如返回條件已經滿足，則立即返回
'==返回值==
'Long ，如fWaitAll設為TRUE，則下述任何一個常數都標誌著成功：
'WAIT_ABANDONED_0： 所有對象都發出消息，而且其中一個或多個屬於互斥體（一但擁有它門的進程中止，就會發出信號）。
'WAIT_TIMEOUT: 對像保持未發信號的狀態 , 但規定的等待超時時間已經超過
'WAIT_OBJECT_0: 所有的對象都發出信號
'WAIT_TO_COMPLETION (僅適用於WaitForSingleObjectEx)，由於一個I/O完成操作已準備好執行，從而造成了函數的返回。
'返回WAIT_FALIED表示函數執行失敗。會設置GetLastError
'如fWaitAll設為FALSE，那返回結果與前面說的相似，只是可能還會返回相對於WAIT_ABANDONED_0或WAIT_OBJECT_0的一個正偏移量，指出哪個對象是被拋棄還是發出信號。
'如果是由於dwWakeMask指定的 , 符合特殊標準的一條消息的到達而造成了函數的返回, 則返回WAIT_OBJECT_0 + nCount
'==參數表==
'參數 類型 及說明
'nCount Long ，指定列表中的句柄數量
'pHandles Long ，指定對像句柄組合中的第一個元素
'fWaitAll Long ，如果為TRUE，表示除非對像同時發出信號，否則就等待下去。如果為FALSE，表示任何對像發出信號即可。
'dwMilliseconds Long ，指定要等待的毫秒數。
'dwWakeMask Long ，帶有QS_？？前綴的一個或多個常數，用於標識特定的消息類型。
'==註解==
'如果函數是由於對像發出信號而返回 , 這個函數還會得到一些額外的效果:
'信號機: 遞增信號機計數
'互斥體: 將互斥體的所有權限賦於發出調用的執行緒
'自動重設事件: 將事件發信狀態設為FALSE
'自動重設可等待計時器: 將計時器狀態設為FALSE
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 WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Private Const WAIT_OBJECT_0& = 0
Private Const WAIT_OBJECT_1& = 1
Private Const WAIT_FAILED& = -1&
Private Const WAIT_TIMEOUT& = &H102&
Private Const WAIT_ABANDONED& = &H80&
Private Const WAIT_ABANDONED_0& = &H80&
Private Const WAIT_IO_COMPLETION& = &HC0&
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)
'GetTickCount()
'Windows NT 3.5 及更高版本，精度為 10ms
'Windows NT 3.1 及更高版本，精度為 16ms
'Windows 95 及更高版本，精度為 55ms
'timeGetTime()
'精度約1ms , 此式適用於大多數應用場合，實際誤差在10ms
'1s = 1000ms = 1000000μs = 1000000000ns
'它傳回Windows啟動後到目前為止所經過的時間，傳回值以微秒為單位。
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
Public Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
'得到處理器使用的主機板內部計時器的時鐘頻率
Private Declare Function QueryPerformanceFrequency Lib "kernel32" ( _
lpFrequency As Currency) As Long 'LARGE_INTEGER
Private Declare Function QueryPerformanceCounter Lib "kernel32" ( _
lpPerformanceCount As Currency) As Long 'LARGE_INTEGER
Public Const MAX_TIMEINTERVAL = 65535
Public Sub Wait1(lngNumberOfSeconds As Long)
Dim ft As FILETIME
Dim lngBusy As Long
Dim lngRet As Long
Dim dblDelay As Double
Dim dblDelayLow As Double
Dim dblUnits As Double
Dim hTimer As Long
hTimer = CreateWaitableTimer(0, True, App.EXEName & "Timer")
If Err.LastDllError = ERROR_ALREADY_EXISTS Then
' If the timer already exists, it does not hurt to open it
' as long as the person who is trying to open it has the
' proper access rights.
Else
ft.dwLowDateTime = -1
ft.dwHighDateTime = -1
lngRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, 0)
End If
' Convert the Units to nanoseconds.
dblUnits = CDbl(&H10000) * CDbl(&H10000)
dblDelay = CDbl(lngNumberOfSeconds) * 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.
ft.dwHighDateTime = -CLng(dblDelay / dblUnits) - 1
dblDelayLow = -dblUnits * (dblDelay / dblUnits - Fix(dblDelay / dblUnits))
If dblDelayLow < CDbl(&H80000000) Then
' &H80000000 is MAX_LONG, so you are just making sure
' that you don't overflow when you try to stick it into
' the FILETIME structure.
dblDelayLow = dblUnits + dblDelayLow
End If
ft.dwLowDateTime = CLng(dblDelayLow)
lngRet = SetWaitableTimer(hTimer, 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.
lngBusy = MsgWaitForMultipleObjects(1, hTimer, False, INFINITE, QS_ALLINPUT&)
DoEvents
Loop Until lngBusy = WAIT_OBJECT_0
' Close the handles when you are done with them.
CloseHandle hTimer
End Sub
'Call Wait(10 000 000) = 1秒
Public Sub Wait(lngNumberOfaHundredNanoSeconds As Long) 'Long= 正負 2,147,483,647
Dim lBusy As Long
Dim lRet As Long
Dim dblDelay As Double
Dim dblDelayLow As Double
Dim dblUnits As Double
Dim hTimer As Long
Dim ft As FILETIME
'FILETIME，指定一個包含了64位元組 時間值的結構。
'如果為正，它代表計時器要觸發的時間。
'如果為負，它代表自函數調用以來持續的時間。
'時間是以100ns為單位指定的
'1s = 1000ms = 1000000μs = 1000000000ns
hTimer = CreateWaitableTimer(0, True, App.EXEName & "Timer")
If Err.LastDllError = ERROR_ALREADY_EXISTS Then
Else
ft.dwLowDateTime = -1
ft.dwHighDateTime = -1
lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, 0)
End If
'轉化為十億分之一秒 = 1奈秒(ns)
dblUnits = CDbl(&H10000) * CDbl(&H10000)
dblDelay = CDbl(lngNumberOfaHundredNanoSeconds) '* 1000 * 10000 '10000000
ft.dwHighDateTime = -CLng(dblDelay / dblUnits) - 1
dblDelayLow = -dblUnits * (dblDelay / dblUnits - Fix(dblDelay / dblUnits))
'&H80000000是最大長度，所以你在寫入FILETIME結構的時候不能超過它
If dblDelayLow < CDbl(&H80000000) Then dblDelayLow = dblUnits + dblDelayLow
ft.dwLowDateTime = CLng(dblDelayLow)
lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, False)
Do
'參數QS_ALLINPUT的意思是MsgWaitForMultipleObjects將返回每次執行緒在運行中獲得
'的消息響應，如果你在這裡需要獲得系統的控制權。你可以使用Doevents
lBusy = MsgWaitForMultipleObjects(1, hTimer, False, INFINITE, QS_ALLINPUT&)
DoEvents
Loop Until lBusy = WAIT_OBJECT_0
'結束時關閉定時器
CloseHandle hTimer
End Sub
這一段
PHP 語法:
Do
'參數QS_ALLINPUT的意思是MsgWaitForMultipleObjects將返回每次執行緒在運行中獲得
'的消息響應，如果你在這裡需要獲得系統的控制權。你可以使用Doevents
lBusy = MsgWaitForMultipleObjects(1, hTimer, False, INFINITE, QS_ALLINPUT&)
DoEvents
Loop Until lBusy = WAIT_OBJECT_0
就是替代的重點
直覺上好像可以用 MsgWaitForMultipleObjects 來解決
實際上??