Wednesday, December 12, 2012

VB6 Code - Fungsi Sleep Atau Wait Yang Diperbaiki

Mengenai fungsi sleep atau wait dalam VB6 yang telah diperbaiki - Fungsi sleep disini berbeda dengan fungsi sleep sebelumnya yang menggunakaan salah satu API kernel32 klik disini atau tanpa API klik disini. Keunggulan dari fungsi sleep kali ini adalah:

  • Tidak memfreeze GUI (jadi jika ada objek visual, maka ia akan terefresh dengan baik)
  • Hitungan dalam millisecond.

Adapun fungsi sleep yang telah diperbaiki dengan menggunakan VB6 adalah sebagai berikut:

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 Sub
Demikian fungsi sleep dalam VB6 dengan menggunakan timer API. Semoga bermanfaat.