Top / プログラミングテクニック / 23.CreateEvent と MsgWaitForMultipleObjects

何かのイベントを待って処理を進めたいときはどうすれば良いでしょう?

VBだけでやるならば、フラグを用意して、DoEvents を発行しながらフラグを監視する方法が挙げられるでしょう。

ただ、DoEvents でループしていると、CPU を使ってしまうので、他で動いているプログラムの反応が鈍くなったりします。

こういうとき、CreateEvent と MsgWaitForMultipleObjects を使用すると、CPU の使用を抑えることができます。

CreateEvent

待機関数(WaitForSingleObject等)で待つためのオブジェクトを作成します。
待機関数は、実行したプログラムを文字通り待機させます。
そして、外から SetEvent してやると、待機関数はその実行を終え、プログラムが再開します。
主に、スレッドの同期処理に使われます。

MsgWaitForMultipleObjects

待機関数の一種で、メッセージ処理と CreateEvent で作成したオブジェクトが SetEvent されるのを待つことができます。

とりあえず、サンプルプログラムです。 API の宣言は長いので後回しです。

Dim mhEvent As Long

Private Sub Form_Load()
    mhEvent = CreateEvent(0, 0, 0, 0)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim nRet As Long
    nRet = CloseHandle(mhEvent)
End Sub

Private Sub Command1_Click()
    Dim nRet As Long
    
    ResetEvent mhEvent
    
    Do
        nRet = MsgWaitForMultipleObjects( _
                    1, _
                    mhEvent, _
                    0, _
                    INFINITE, _
                    QS_ALLINPUT)
        
        Select Case nRet
            Case WAIT_FAILED
                MsgBox "WAIT_FAILED"
                Exit Sub
            Case WAIT_OBJECT_0
                Exit Do
            Case Else
                DoEvents
        End Select
    Loop
    
    MsgBox "完了!"

End Sub

Private Sub Command2_Click()
    SetEvent mhEvent
End Sub

Command1 ボタンを押すと、ループが開始され、Command2 ボタンを押すと、ループから抜け出し、メッセージボックスが表示されます。

その間、タスクマネージャで確認してみてください。
CPU をほとんど使用しません。
それでいて、フォームの移動や、最小化には即座に反応してくれます。

また、フォームを閉じると、オブジェクトのハンドルがクローズされ、WAIT_FAILED のメッセージボックスが表示されます。

これ、実は22.処理の中断にも使えます。

MsgWaitForMultipleObjects の dwMilliseconds にゼロをセットすれば、イベントがなければ、WAIT_TIMEOUT で即座にリターンするので、そこで続行するよう記述すればOKです。

では、API、型、定数の宣言です。

Option Explicit

Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Type MSG
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Private Declare Function CreateEvent _
            Lib "kernel32" _
            Alias "CreateEventA" ( _
            ByVal lpEventAttributes As Long, _
            ByVal bManualReset As Long, _
            ByVal bInitialState As Long, _
            ByVal lpName As Long _
            ) As Long
            
Private Declare Function SetEvent _
            Lib "kernel32" _
            (ByVal hEvent As Long) As Long

Private Declare Function ResetEvent _
            Lib "kernel32" _
            (ByVal hEvent As Long) As Long

Private Declare Function CloseHandle _
            Lib "kernel32" _
            (ByVal hObject As Long) As Long

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

Private Declare Function PeekMessage _
            Lib "user32" _
            Alias "PeekMessageA" ( _
            lpMsg As MSG, _
            ByVal hwnd As Long, _
            ByVal wMsgFilterMin As Long, _
            ByVal wMsgFilterMax As Long, _
            ByVal wRemoveMsg 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 Const WAIT_OBJECT_0     As Long = 0
Private Const QS_KEY            As Long = &H1
Private Const QS_MOUSEMOVE      As Long = &H2
Private Const QS_MOUSEBUTTON    As Long = &H4
Private Const QS_POSTMESSAGE    As Long = &H8
Private Const QS_TIMER          As Long = &H10
Private Const QS_PAINT          As Long = &H20
Private Const QS_SENDMESSAGE    As Long = &H40
Private Const QS_HOTKEY         As Long = &H80
Private Const QS_MOUSE          As Long = _
                     QS_MOUSEMOVE Or QS_MOUSEBUTTON
Private Const QS_INPUT          As Long = _
                     QS_MOUSE Or QS_KEY
Private Const QS_ALLEVENTS      As Long = _
                     QS_INPUT Or QS_POSTMESSAGE _
                  Or QS_TIMER Or QS_PAINT Or QS_HOTKEY
Private Const QS_ALLINPUT       As Long = _ 
                     QS_SENDMESSAGE Or QS_PAINT _
                  Or QS_TIMER Or QS_POSTMESSAGE _
                  Or QS_MOUSEBUTTON Or QS_MOUSEMOVE _
                  Or QS_HOTKEY Or QS_KEY

Private Const WAIT_FAILED       As Long = &HFFFFFFFF
Private Const INFINITE          As Long = &HFFFFFFFF

Private Const PM_REMOVE         As Long = &H1
Private Const STATUS_TIMEOUT    As Long = &H102
Private Const WAIT_TIMEOUT      As Long = STATUS_TIMEOUT



トップ   編集 凍結 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   最終更新のRSS
Last-modified: 2009-11-23 (月) 03:33:04 (3674d)