source: trunk/ab5.0/ablib/src/Classes/System/Threading/Timer.ab@ 678

/*
@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