source: trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Timer.ab@ 677

/*
@brief タイマ
*/

Namespace ActiveBasic
Namespace Windows
Namespace UI

Class Timer
Public
    'Timer クラスの新しいインスタンスを初期化します。
    Sub Timer()
        Dim tc As TIMECAPS
        timeGetDevCaps(tc,SizeOf(TIMECAPS))
        If 50 < tc.wPeriodMin Then
            '今の時代にこんなPCはほとんどないだろうけど念のため
            This.resolution = tc.wPeriodMin
        Else
            'Froms.Timerの精度は55msec前後
            This.resolution = 50
        End If
    End Sub

    'タイマが実行されているかどうかを取得または設定します。
    Sub Enabled(value As Boolean)
        If value Then 
            If This.id=0 Then This.Start()
        Else
            If This.id Then This.Stop()
        End If
    End Sub
    Function Enabled() As Boolean
        Return This.enabled
    End Function

    'Tick イベントが発生してから次の Tick イベントが発生するまでの時間 (ミリ秒単位) を取得または設定します。
    Sub Interval(value As Long)
        This.interval = value
    End Sub
    Function Interval() As Long
        Return This.interval
    End Function

/*  'なんらかの種類のユーザー状態を表す任意の文字列を取得または設定します。
    Sub Tag(value As Object)
        This.tag = value
    End Sub
    Function Tag() As Object
        Return This.tag
    End Function*/

    'オーバーロードされます。
    Sub Dispose()
        This.Stop()
    End Sub

    'タイマを起動します。
    Sub Start()
        This.id = timeSetEvent(This.interval,This.resolution,AddressOf(Detail.TimerProc_Impl),ObjPtr(This) As ULONG_PTR,TIME_PERIODIC or TIME_CALLBACK_FUNCTION)
        If This.id Then This.enabled = True Else This.enabled = False
    End Sub

    'タイマを停止します。
    Sub Stop()
        timeKillEvent(This.id)
        This.id = 0
        This.enabled = False
    End Sub

    'Timer を表す文字列を返します。
    Override Function ToString() As String
    End Function

Protected
    'Tick イベントを発生させます。
    Virtual Sub OnTick(e As System.EventArgs)
        If Not IsNothing(Tick) Then
            Tick(This, e)
        End If
    End Sub

Protected
    id As ULONG_PTR
    interval As Long
    resolution As DWord
    enabled As Boolean
    tag As Object

Public
    Sub AddTick(h As System.EventHandler)
        If IsNothing(Tick) Then
            Tick = h
        Else
            Tick += h
        End If
    End Sub
    Sub RemoveTick(h As System.EventHandler)
        If Not IsNothing(Tick) Then
            Tick -= h
        End If
    End Sub

    Tick As System.EventHandler
End Class


Namespace Detail
    Class Timer_Impl
        Inherits Timer

    Public
        Sub OnTick()
            Super.OnTick(Nothing)
        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 timer As Timer_Impl
        timer = dwUser As Timer_Impl
        timer.OnTick()
    End Sub

End Namespace

End Namespace 'UI
End Namespace 'Widnows
End Namespace 'ActiveBasic