Skip to content

Instantly share code, notes, and snippets.

@kumatti1
Created Mar 21, 2014
Embed
What would you like to do?
SetTimerで同期オブジェクト
Option Explicit
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As LongPtr
bInheritHandle As Long
End Type
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
Const QS_ALLINPUT = &HFF
Const INFINITE = &HFFFFFFFF
Const WAIT_OBJECT_0 = &H0&
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare PtrSafe Function CreateEvent Lib "kernel32" Alias "CreateEventA" (lpEventAttributes As SECURITY_ATTRIBUTES, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As LongPtr
Private Declare PtrSafe Function SetEvent Lib "kernel32" (ByVal hEvent As LongPtr) As Long
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 KillTimer Lib "user32" _
(ByVal hWnd As Long, ByVal uIDEvent As Long) As Long
Private hEvent As LongPtr
Sub main()
Dim st As SECURITY_ATTRIBUTES
hEvent = CreateEvent(st, 0, 0, vbNullString)
If hEvent = 0 Then Exit Sub
SetTimer 0, 0, 0, AddressOf TimerProc
Do While MsgWaitForMultipleObjects(1, hEvent, 0, _
INFINITE, QS_ALLINPUT) = WAIT_OBJECT_0 + 1
DoEvents
Loop
CloseHandle hEvent
Debug.Print "呼び出し元"
End Sub
Private Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal idEvent As Long, ByVal dwTime As Long)
KillTimer 0, idEvent
Debug.Print "TimerProc"
SetEvent hEvent
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment