Changeset 679 for trunk/ab5.0

Timestamp:

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

Author:

イグトランス (egtra)

Message:

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

Location:

trunk/ab5.0/ablib

Files:

• TestCase/UI_Sample/step32_AnalogWatch.ab (added)
• src/Classes/ActiveBasic/Windows/UI/Control.ab (modified) (1 diff)
• src/Classes/ActiveBasic/Windows/UI/Timer.ab (modified) (6 diffs)
• src/api_gdi.sbp (modified) (1 diff)

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

trunk/ab5.0/ablib/src/api_gdi.sbp

@@ -788 +788 @@
 
 Declare Function ExtSelectClipRgn Lib "gdi32" (hdc As HDC, hRgn As HRGN, fnMode As Long) As Long
+Const ETO_OPAQUE = &h0002
+Const ETO_CLIPPED = &h0004
+'#if WINVER >= &h0400
+Const ETO_GLYPH_INDEX = &h0010
+Const ETO_RTLREADING = &h0080
+Const ETO_NUMERICSLOCAL = &h0400
+Const ETO_NUMERICSLATIN = &h0800
+Const ETO_IGNORELANGUAGE = &h1000
+'#endif
+'#if _WIN32_WINNT >= &h0500
+'Const ETO_PDY = &h2000
+'#endif
+'#if _WIN32_WINNT >= &h0600
+'Const ETO_REVERSE_INDEX_MAP = &h10000
+'#endif
 Declare Function ExtTextOutA Lib "gdi32" (hdc As HDC, x As Long, y As Long, fuOptions As DWord, ByRef rc As RECT, lpString As PCSTR, cbCount As Long, pDx As *Long) As Long
 Declare Function ExtTextOutW Lib "gdi32" (hdc As HDC, x As Long, y As Long, fuOptions As DWord, ByRef rc As RECT, lpString As PCWSTR, cbCount As Long, pDx As *Long) As Long