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
       Dim udtMsg As MSG
       
       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 (2772d)