Changeset 679 for trunk/ab5.0/ablib/src/Classes

Timestamp:

Jan 26, 2009, 1:53:37 AM (15 years ago)

Author:

イグトランス (egtra)

Message:

UI.TimerをWM_TIMER使用に修正。Step32時計のサンプルを追加。

Location:

trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI

Files:

• Control.ab (modified) (1 diff)
• Timer.ab (modified) (6 diffs)

trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab

@@ -1 +1 @@
 'Classes/ActiveBasic/Windows/UI/Control.ab
 
+#require <Classes/ActiveBasic/Windows/UI/WindowHandle.ab>
 #require <Classes/ActiveBasic/Windows/UI/EventArgs.ab>
 #require <Classes/ActiveBasic/COM/ComClassBase.ab>

trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Timer.ab

@@ +1 @@
+
+#require <Classes/ActiveBasic/Windows/UI/Control.ab>
 /*
 @brief タイマ
@@ -10 +12 @@
 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
+    Sub Timer(control As Control)
+        If IsNothing(control) Then
+            Throw New System.ArgumentNullException("control")
+        EndIf
+        ctrl = control
     End Sub
 
@@ -25 +22 @@
     Sub Enabled(value As Boolean)
         If value Then 
-            If This.id=0 Then This.Start()
+            If This.handle=0 Then This.Start()
         Else
-            If This.id Then This.Stop()
+            If This.handle Then This.Stop()
         End If
     End Sub
     Function Enabled() As Boolean
-        Return This.enabled
+        Return handle <> 0
     End Function
 
@@ -52 +49 @@
     'オーバーロードされます。
     Sub Dispose()
-        This.Stop()
+        killImpl()
     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
+        If handle = 0 Then
+            handle = AllocObjectHandle(This)
+            If SetTimer(ctrl As HWND, handle, interval, AddressOf(timerProc)) = 0 Then
+                ThrowWithLastError()
+            End If
+        End If
     End Sub
 
     'タイマを停止します。
     Sub Stop()
-        timeKillEvent(This.id)
-        This.id = 0
-        This.enabled = False
+        If killImpl() = 0 Then
+            ThrowWithLastError()
+        End If
     End Sub
 
@@ -80 +81 @@
     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)
@@ -100 +94 @@
         End If
     End Sub
+Private
+    Static Sub timerProc(hwnd As HWND, msg As DWord, id As ULONG_PTR, time As DWord)
+        Dim timer = GetObjectFromHandle(id) As Timer
+        timer.OnTick(Nothing)
+    End Sub
+
+    Function killImpl() As Boolean
+        If handle <> 0 Then
+            killImpl = KillTimer(ctrl As HWND, handle) <> 0
+            ReleaseObjectHandle(handle)
+            handle = 0
+        End If
+    End Function
 
     Tick As System.EventHandler
+    ctrl As Control
+    handle As LONG_PTR 'タイマ実行中のGC回避およびタイマIDとして使用
+    interval As DWord
 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