'Classes/ActiveBasic/Windows/UI/Application.ab #require Namespace ActiveBasic Namespace Windows Namespace UI Delegate Function MessageFilter(m As *MSG) As Boolean /*! @date 2008/07/13 @brief アプリケーション全体に関わるようなこと……、主にメッセージループを管理するクラス。 @todo メッセージフィルタとマルチスレッド対応 @author Egtra */ Class Application Public /*! @brief メッセージループを回す @date 2008/07/13 @param[in] form メインウィンドウ @author Egtra */ Static Sub Run(form As Form) If IsNothing(form) = False Then form.Show(SW_SHOW) form.Update() form.AddMessageEvent(WM_DESTROY, AddressOf(OnMainFormClosed)) End If Dim m As MSG Do Dim ret = GetMessage(m, 0, 0, 0) If ret = 0 Or ret = -1 Then Exit Do End If dispatchMessage(m) Loop End Sub /*! @brief メインウィンドウなしでメッセージループを回す @date 2008/07/13 @author Egtra */ Static Sub Run() Run(Nothing) End Sub /*! @brief メッセージループを終わらせる。 @date 2008/07/13 @author Egtra */ Static Sub ExitThread() PostQuitMessage(0) End Sub /*! @brief メッセージキューに溜まったメッセージを処理する。 @date 2008/07/18 @author Egtra ここのコードから改変。 http://www.activebasic.com/forum/viewtopic.php?t=426 */ Static Sub DoEvents() Dim msg As MSG While PeekMessage(msg, 0, 0, 0, PM_REMOVE) <> FALSE Select Case msg.message Case WM_QUIT PostQuitMessage(0) 'Run()で捕まえてくれるようPostしなおす。 Case Else dispatchMessage(msg) End Select Wend End Sub /* Static Sub AddMessageFilter(mf As MessageFilter) If IsNothing(filter) Then filter = New System.Collections.Generic.List End If filter.Add(mf) End Sub Static Sub RemoveMessageFilter(mf As MessageFilter) filter.Remove(mf) End Sub */ #include "ApplicationEvent.sbp" Private Static Sub OnMainFormClosed(sender As Object, e As Args) OnThreadExit(Args.Empty) ExitThread() End Sub Static Sub dispatchMessage(ByRef m As MSG) /* If IsNothing(filter) = False Then For Each f In filter Next End If */ TranslateMessage(m) DispatchMessage(m) End Sub ' Static filter As System.Collections.Generic.List End Class End Namespace 'UI End Namespace 'Widnows End Namespace 'ActiveBasic