- Tidak memfreeze GUI (jadi jika ada objek visual, maka ia akan terefresh dengan baik)
- Hitungan dalam millisecond.
Option Explicit
Private mCancel As Boolean
Type MSG
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
ptX As Long
ptY As Long
End Type
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Private Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As MSG) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Sub TimerProc()
mCancel = True
End Sub
Public Sub Wait(frm As Form, mSecs As Long)
Dim MyMsg As MSG
Dim TimerID As Long
TimerID = SetTimer(frm.hwnd, ObjPtr(frm), mSecs, AddressOf TimerProc)
mCancel = False
Do While Not mCancel
GetMessage MyMsg, 0, 0, 0
TranslateMessage MyMsg
DispatchMessage MyMsg
Loop
KillTimer frm.hwnd, TimerID
End SubDemikian fungsi sleep dalam VB6 dengan menggunakan timer API. Semoga bermanfaat.Source : http://vb6-sourcecode-insert.blogspot.com/
No comments:
Post a Comment