1 | /*
|
---|
2 | @brief タイマ
|
---|
3 | */
|
---|
4 |
|
---|
5 | Namespace System
|
---|
6 | Namespace Threading
|
---|
7 |
|
---|
8 | Delegate Sub TimerCallback ( state As Object )
|
---|
9 |
|
---|
10 | Class Timer
|
---|
11 | Sub _Initialize( callback As TimerCallback, state As Object, dueTime As Int64, period As Int64 )
|
---|
12 | timeGetDevCaps(tc,SizeOf(TIMECAPS))
|
---|
13 | This.state = state
|
---|
14 | This.callback = callback
|
---|
15 | This._Change(dueTime,period)
|
---|
16 | End Sub
|
---|
17 |
|
---|
18 | Sub _Change(dueTime As Int64, period As Int64 )
|
---|
19 | If This.id Then
|
---|
20 | timeKillEvent(This.id)
|
---|
21 | This.id = 0
|
---|
22 | End If
|
---|
23 | Select Case dueTime As Long
|
---|
24 | Case 0
|
---|
25 | 'ノータイムで開始
|
---|
26 | Detail.TimerProc_Impl(This.id,0,ObjPtr(This) As ULONG_PTR,0,0)
|
---|
27 | Case -1
|
---|
28 | 'タイマーは開始されない
|
---|
29 | Exit Sub
|
---|
30 | Case Else
|
---|
31 | 'ディレイ後に開始
|
---|
32 | This.id = timeSetEvent(dueTime As DWord,tc.wPeriodMin,AddressOf(Detail.TimerProc_Impl),ObjPtr(This) As ULONG_PTR,TIME_ONESHOT or TIME_CALLBACK_FUNCTION)
|
---|
33 | End Select
|
---|
34 |
|
---|
35 | This.dueTime = dueTime
|
---|
36 | This.period = period
|
---|
37 | End Sub
|
---|
38 |
|
---|
39 | Public
|
---|
40 | 'Timer クラスの新しいインスタンスを初期化します。
|
---|
41 | Sub Timer ( callback As TimerCallback, state As Object, dueTime As Long, period As Long )
|
---|
42 | This._Initialize(callback,state,dueTime As Int64,period As Int64)
|
---|
43 | End Sub
|
---|
44 | Sub Timer ( callback As TimerCallback, state As Object, dueTime As Int64, period As Int64 )
|
---|
45 | This._Initialize(callback,state,dueTime As Int64,period As Int64)
|
---|
46 | End Sub
|
---|
47 | Sub Timer ( callback As TimerCallback, state As Object, dueTime As TimeSpan, period As TimeSpan )
|
---|
48 | This._Initialize(callback,state,dueTime.Ticks As Int64,period.Ticks As Int64)
|
---|
49 | End Sub
|
---|
50 | Sub Timer ( callback As TimerCallback, state As Object, dueTime As DWord, period As DWord )
|
---|
51 | This._Initialize(callback,state,dueTime As Int64,period As Int64)
|
---|
52 | End Sub
|
---|
53 | Sub Timer ( callback As TimerCallback )
|
---|
54 | This._Initialize(callback,Nothing,Timeout.Infinite As Int64,Timeout.Infinite As Int64)
|
---|
55 | End Sub
|
---|
56 |
|
---|
57 | 'オーバーロードされます。
|
---|
58 | Sub Dispose()
|
---|
59 | timeKillEvent(This.id)
|
---|
60 | End Sub
|
---|
61 |
|
---|
62 | 'タイマの開始時刻とメソッドの呼び出しの間隔を変更
|
---|
63 | Function Change ( dueTime As Long, period As Long ) As Boolean
|
---|
64 | This._Change(dueTime As Int64,period As Int64)
|
---|
65 | End Function
|
---|
66 | Function Change ( dueTime As Int64, period As Int64 ) As Boolean
|
---|
67 | This._Change(dueTime As Int64,period As Int64)
|
---|
68 | End Function
|
---|
69 | Function Change ( dueTime As TimeSpan, period As TimeSpan ) As Boolean
|
---|
70 | This._Change(dueTime.Ticks As Int64,period.Ticks As Int64)
|
---|
71 | End Function
|
---|
72 | Function Change ( dueTime As DWord, period As DWord ) As Boolean
|
---|
73 | This._Change(dueTime As Int64,period As Int64)
|
---|
74 | End Function
|
---|
75 |
|
---|
76 | Protected
|
---|
77 | callback As TimerCallback
|
---|
78 | state As Object
|
---|
79 | dueTime As Int64
|
---|
80 | period As Int64
|
---|
81 | id As MMRESULT
|
---|
82 | tc As TIMECAPS
|
---|
83 |
|
---|
84 | End Class
|
---|
85 |
|
---|
86 |
|
---|
87 | Namespace Detail
|
---|
88 | Class Timer_Impl
|
---|
89 | Inherits System.Threading.Timer
|
---|
90 | Public
|
---|
91 | Sub Callback()
|
---|
92 | If Not IsNothing(callback) Then
|
---|
93 | callback(This.state)
|
---|
94 | End If
|
---|
95 |
|
---|
96 | '一回だけ実行
|
---|
97 | If (period As Long) = -1 Then
|
---|
98 | 'ここで終了
|
---|
99 | If id Then
|
---|
100 | timeKillEvent(This.id)
|
---|
101 | This.id = 0
|
---|
102 | Exit Sub
|
---|
103 | End If
|
---|
104 |
|
---|
105 | '周期的に実行
|
---|
106 | Else
|
---|
107 | 'ディレイ後に開始された
|
---|
108 | If dueTime As Long Then
|
---|
109 | timeKillEvent(This.id)
|
---|
110 | This.id = timeSetEvent(This.period As DWord,tc.wPeriodMin,AddressOf(Detail.TimerProc_Impl),ObjPtr(This) As ULONG_PTR,TIME_PERIODIC or TIME_CALLBACK_FUNCTION)
|
---|
111 | This.dueTime =0
|
---|
112 | End If
|
---|
113 | End If
|
---|
114 | End Sub
|
---|
115 | End Class
|
---|
116 | Sub TimerProc_Impl(uID As DWord, uMsg As DWord, dwUser As DWORD_PTR, dw1 As DWORD_PTR, dw2 As DWORD_PTR)
|
---|
117 | Dim obj As Timer_Impl
|
---|
118 | obj = dwUser As Timer_Impl
|
---|
119 | obj.Callback()
|
---|
120 | End Sub
|
---|
121 | End Namespace
|
---|
122 |
|
---|
123 | End Namespace
|
---|
124 | End Namespace
|
---|