[677] | 1 | /*
|
---|
| 2 | @brief タイマ
|
---|
| 3 | */
|
---|
| 4 |
|
---|
| 5 | Namespace ActiveBasic
|
---|
| 6 | Namespace Windows
|
---|
| 7 | Namespace UI
|
---|
| 8 |
|
---|
| 9 | Class Timer
|
---|
| 10 | Public
|
---|
| 11 | 'Timer クラスの新しいインスタンスを初期化します。
|
---|
| 12 | Sub Timer()
|
---|
| 13 | Dim tc As TIMECAPS
|
---|
| 14 | timeGetDevCaps(tc,SizeOf(TIMECAPS))
|
---|
| 15 | If 50 < tc.wPeriodMin Then
|
---|
| 16 | '今の時代にこんなPCはほとんどないだろうけど念のため
|
---|
| 17 | This.resolution = tc.wPeriodMin
|
---|
| 18 | Else
|
---|
| 19 | 'Froms.Timerの精度は55msec前後
|
---|
| 20 | This.resolution = 50
|
---|
| 21 | End If
|
---|
| 22 | End Sub
|
---|
| 23 |
|
---|
| 24 | 'タイマが実行されているかどうかを取得または設定します。
|
---|
| 25 | Sub Enabled(value As Boolean)
|
---|
| 26 | If value Then
|
---|
| 27 | If This.id=0 Then This.Start()
|
---|
| 28 | Else
|
---|
| 29 | If This.id Then This.Stop()
|
---|
| 30 | End If
|
---|
| 31 | End Sub
|
---|
| 32 | Function Enabled() As Boolean
|
---|
| 33 | Return This.enabled
|
---|
| 34 | End Function
|
---|
| 35 |
|
---|
| 36 | 'Tick イベントが発生してから次の Tick イベントが発生するまでの時間 (ミリ秒単位) を取得または設定します。
|
---|
| 37 | Sub Interval(value As Long)
|
---|
| 38 | This.interval = value
|
---|
| 39 | End Sub
|
---|
| 40 | Function Interval() As Long
|
---|
| 41 | Return This.interval
|
---|
| 42 | End Function
|
---|
| 43 |
|
---|
| 44 | /* 'なんらかの種類のユーザー状態を表す任意の文字列を取得または設定します。
|
---|
| 45 | Sub Tag(value As Object)
|
---|
| 46 | This.tag = value
|
---|
| 47 | End Sub
|
---|
| 48 | Function Tag() As Object
|
---|
| 49 | Return This.tag
|
---|
| 50 | End Function*/
|
---|
| 51 |
|
---|
| 52 | 'オーバーロードされます。
|
---|
| 53 | Sub Dispose()
|
---|
| 54 | This.Stop()
|
---|
| 55 | End Sub
|
---|
| 56 |
|
---|
| 57 | 'タイマを起動します。
|
---|
| 58 | Sub Start()
|
---|
| 59 | This.id = timeSetEvent(This.interval,This.resolution,AddressOf(Detail.TimerProc_Impl),ObjPtr(This) As ULONG_PTR,TIME_PERIODIC or TIME_CALLBACK_FUNCTION)
|
---|
| 60 | If This.id Then This.enabled = True Else This.enabled = False
|
---|
| 61 | End Sub
|
---|
| 62 |
|
---|
| 63 | 'タイマを停止します。
|
---|
| 64 | Sub Stop()
|
---|
| 65 | timeKillEvent(This.id)
|
---|
| 66 | This.id = 0
|
---|
| 67 | This.enabled = False
|
---|
| 68 | End Sub
|
---|
| 69 |
|
---|
| 70 | 'Timer を表す文字列を返します。
|
---|
| 71 | Override Function ToString() As String
|
---|
| 72 | End Function
|
---|
| 73 |
|
---|
| 74 | Protected
|
---|
| 75 | 'Tick イベントを発生させます。
|
---|
| 76 | Virtual Sub OnTick(e As System.EventArgs)
|
---|
| 77 | If Not IsNothing(Tick) Then
|
---|
| 78 | Tick(This, e)
|
---|
| 79 | End If
|
---|
| 80 | End Sub
|
---|
| 81 |
|
---|
| 82 | Protected
|
---|
| 83 | id As ULONG_PTR
|
---|
| 84 | interval As Long
|
---|
| 85 | resolution As DWord
|
---|
| 86 | enabled As Boolean
|
---|
| 87 | tag As Object
|
---|
| 88 |
|
---|
| 89 | Public
|
---|
| 90 | Sub AddTick(h As System.EventHandler)
|
---|
| 91 | If IsNothing(Tick) Then
|
---|
| 92 | Tick = h
|
---|
| 93 | Else
|
---|
| 94 | Tick += h
|
---|
| 95 | End If
|
---|
| 96 | End Sub
|
---|
| 97 | Sub RemoveTick(h As System.EventHandler)
|
---|
| 98 | If Not IsNothing(Tick) Then
|
---|
| 99 | Tick -= h
|
---|
| 100 | End If
|
---|
| 101 | End Sub
|
---|
| 102 |
|
---|
| 103 | Tick As System.EventHandler
|
---|
| 104 | End Class
|
---|
| 105 |
|
---|
| 106 |
|
---|
| 107 | Namespace Detail
|
---|
| 108 | Class Timer_Impl
|
---|
| 109 | Inherits Timer
|
---|
| 110 |
|
---|
| 111 | Public
|
---|
| 112 | Sub OnTick()
|
---|
| 113 | Super.OnTick(Nothing)
|
---|
| 114 | End Sub
|
---|
| 115 | End Class
|
---|
| 116 |
|
---|
| 117 | Sub TimerProc_Impl(uID As DWord, uMsg As DWord, dwUser As DWORD_PTR, dw1 As DWORD_PTR, dw2 As DWORD_PTR)
|
---|
| 118 | Dim timer As Timer_Impl
|
---|
| 119 | timer = dwUser As Timer_Impl
|
---|
| 120 | timer.OnTick()
|
---|
| 121 | End Sub
|
---|
| 122 |
|
---|
| 123 | End Namespace
|
---|
| 124 |
|
---|
| 125 | End Namespace 'UI
|
---|
| 126 | End Namespace 'Widnows
|
---|
| 127 | End Namespace 'ActiveBasic
|
---|