/* @brief タイマ */ Namespace System Namespace Threading Delegate Sub TimerCallback ( state As Object ) Class Timer Sub _Initialize( callback As TimerCallback, state As Object, dueTime As Int64, period As Int64 ) timeGetDevCaps(tc,SizeOf(TIMECAPS)) This.state = state This.callback = callback This._Change(dueTime,period) End Sub Sub _Change(dueTime As Int64, period As Int64 ) If This.id Then timeKillEvent(This.id) This.id = 0 End If Select Case dueTime As Long Case 0 'ノータイムで開始 Detail.TimerProc_Impl(This.id,0,ObjPtr(This) As ULONG_PTR,0,0) Case -1 'タイマーは開始されない Exit Sub Case Else 'ディレイ後に開始 This.id = timeSetEvent(dueTime As DWord,tc.wPeriodMin,AddressOf(Detail.TimerProc_Impl),ObjPtr(This) As ULONG_PTR,TIME_ONESHOT or TIME_CALLBACK_FUNCTION) End Select This.dueTime = dueTime This.period = period End Sub Public 'Timer クラスの新しいインスタンスを初期化します。 Sub Timer ( callback As TimerCallback, state As Object, dueTime As Long, period As Long ) This._Initialize(callback,state,dueTime As Int64,period As Int64) End Sub Sub Timer ( callback As TimerCallback, state As Object, dueTime As Int64, period As Int64 ) This._Initialize(callback,state,dueTime As Int64,period As Int64) End Sub Sub Timer ( callback As TimerCallback, state As Object, dueTime As TimeSpan, period As TimeSpan ) This._Initialize(callback,state,dueTime.Ticks As Int64,period.Ticks As Int64) End Sub Sub Timer ( callback As TimerCallback, state As Object, dueTime As DWord, period As DWord ) This._Initialize(callback,state,dueTime As Int64,period As Int64) End Sub Sub Timer ( callback As TimerCallback ) This._Initialize(callback,Nothing,Timeout.Infinite As Int64,Timeout.Infinite As Int64) End Sub 'オーバーロードされます。 Sub Dispose() timeKillEvent(This.id) End Sub 'タイマの開始時刻とメソッドの呼び出しの間隔を変更 Function Change ( dueTime As Long, period As Long ) As Boolean This._Change(dueTime As Int64,period As Int64) End Function Function Change ( dueTime As Int64, period As Int64 ) As Boolean This._Change(dueTime As Int64,period As Int64) End Function Function Change ( dueTime As TimeSpan, period As TimeSpan ) As Boolean This._Change(dueTime.Ticks As Int64,period.Ticks As Int64) End Function Function Change ( dueTime As DWord, period As DWord ) As Boolean This._Change(dueTime As Int64,period As Int64) End Function Protected callback As TimerCallback state As Object dueTime As Int64 period As Int64 id As MMRESULT tc As TIMECAPS End Class Namespace Detail Class Timer_Impl Inherits System.Threading.Timer Public Sub Callback() If Not IsNothing(callback) Then callback(This.state) End If '一回だけ実行 If (period As Long) = -1 Then 'ここで終了 If id Then timeKillEvent(This.id) This.id = 0 Exit Sub End If '周期的に実行 Else 'ディレイ後に開始された If dueTime As Long Then timeKillEvent(This.id) This.id = timeSetEvent(This.period As DWord,tc.wPeriodMin,AddressOf(Detail.TimerProc_Impl),ObjPtr(This) As ULONG_PTR,TIME_PERIODIC or TIME_CALLBACK_FUNCTION) This.dueTime =0 End If End If End Sub End Class Sub TimerProc_Impl(uID As DWord, uMsg As DWord, dwUser As DWORD_PTR, dw1 As DWORD_PTR, dw2 As DWORD_PTR) Dim obj As Timer_Impl obj = dwUser As Timer_Impl obj.Callback() End Sub End Namespace End Namespace End Namespace