07. Этот пример показывает как с использованием API интерфейса запустить таймер для выполнения некоторой программы. При описании программы используется функция AddressOf, возвращающая указатель на внешнюю программу.
Private hTimer As Long ' Указатель на запущенный процесс
Private Const TIME_ONESHOT = 0 ' Событие случается однажды
Private Const TIME_PERIODIC = 1 ' Событие случается через uDelay миллисекунд
' Запуск процесса
Private Declare Function apiTimeSetEvent Lib "winmm.dll" Alias "timeSetEvent" _
(ByVal uDelay As Long, _
ByVal uResolution As Long, _
ByVal lpFunction As Long, _
ByVal dwUser As Long, _
ByVal uFlags As Long) As Long
' Уничтожение процесса
Private Declare Function apiTimeKillEvent Lib "winmm.dll" Alias "timeKillEvent" _
(ByVal uID As Long) As Long
' Функция запуска событий
Private Sub butExec_Click()
Dim uDelay As Long
Dim uResolution As Long
Dim dwUser As Long
Dim fuEvent As Long
uDelay = Me.uDelay * 1000 ' Число секунд
uResolution = Me.uResolution
dwUser = Me.dwUser
uFlags = Me.uFlags ' uFlags = TIME_PERIODIC
hTimer = apiTimeSetEvent(uDelay, _
uResolution, _
AddressOf funTimerProc, _
dwUser, _
uFlags)
End Sub
' Программа для выполнения процесса таймера
Public Function funTimerProc(ByVal uID As Long, _
ByVal uMsg As Long, _
ByVal dwUser As Long, _
ByVal dw1 As Long, _
ByVal dw2 As Long) As Long
Dim frm As Form
Set frm = Forms("Example 07")
frm.msg = "Время: " Format(time, "hh:nn:ss") _
", ID= " uID _
", Msg=" uMsg _
", User=" dwUser _
", dw1=" dw1 _
", dw2=" dw2 vbNewLine frm.msg
funTimerProc = 0
' Debug.Print uID, uMsg, dwUser, dw1, dw2
End Function