Программирование на Visual Basic

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