Index: /trunk/ab5.0/ablib/TestCase/UI_Sample/step32_AnalogWatch.ab =================================================================== --- /trunk/ab5.0/ablib/TestCase/UI_Sample/step32_AnalogWatch.ab (revision 679) +++ /trunk/ab5.0/ablib/TestCase/UI_Sample/step32_AnalogWatch.ab (revision 679) @@ -0,0 +1,125 @@ +/*! +@file +@brief 「Win32プログラミング講座 ～ Step32. アナログ時計を作る ～」のAB5移植版 +http://www.activebasic.com/help_center/articles/win32/step05/ +メニューは未実装。 + +@date 2008/07/20 +@auther Egtra +*/ + +#require +#require +#require + +Imports ActiveBasic.Windows.UI +Imports ActiveBasic.Math +Imports System + +#resource "UI_Sample.rc" + +Const PAI = 3.14159265358979323846264 + +Class WatchForm + Inherits Form +Public + Sub WatchForm() + AddCreate(AddressOf(OnCreate)) + AddPaintDC(AddressOf(OnPaint_)) + AddPaintBackground(AddressOf(OnPaintBackground_)) + End Sub + +Protected + Override Sub GetCreateStruct(ByRef cs As CREATESTRUCT) + Super.GetCreateStruct(cs) + With cs + .cx = 240 + .cy = 240 + .lpszName = "clock" + End With + End Sub + +Private + Sub OnCreate(sender As Object, e As CreateArgs) + timer = New Timer(This) + With timer + .Interval = 100 '元に忠実にするなら10 + .AddTick(AddressOf(Timer_OnTick)) + .Start() + End With + GetLocalTime(st) + End Sub + + Sub Timer_OnTick(sender As Object, e As Args) + Dim wsec As Word + wsec = st.wSecond + GetLocalTime(st) + '秒針を動かす必要があるときは再描画する + If wsec <> st.wSecond Then Invalidate() + End Sub + + Sub OnPaintBackground_(sender As Object, e As PaintBackgroundArgs) + Dim hdc = e.Handle + Dim rc = This.ClientRect + Dim hbrOld = SelectObject(hdc, GetStockObject(WHITE_BRUSH)) + ExtTextOut(hdc, 0, 0, ETO_OPAQUE, rc, "", 0, 0) + SelectObject(hdc, hbrOld) + End Sub + + Sub OnPaint_(sender As Object, e As PaintDCArgs) + Dim hPen As HPEN, hOldPen As HPEN + Dim pos As POINTAPI + + Dim hdc = e.Handle + Dim rc = This.ClientRect + + Dim CenterPos As POINTAPI '針の中心位置 + '針の中心位置 + CenterPos.x = rc.right \ 2 + CenterPos.y = rc.bottom \ 2 + + '3つとも元と違ってDouble型にしている。 + Dim Length_Second = Math.Min(rc.bottom, rc.right) / 2.0 - 2.0 '秒針の長さ + Dim Length_Minute = Length_Second As Double '短針の長さ + Dim Length_Hour = Length_Minute * 0.70 '長針の長さ + + '短針 + If st.wHour=12 Then st.wHour=0 + hPen=CreatePen(PS_SOLID,5,RGB(255,100,0)) + hOldPen=SelectObject(hdc,hPen) + pos.x=(CenterPos.x + Length_Hour * Sin(st.wHour * PAI / 6 + st.wMinute * PAI / 360)) As Long + pos.y=(CenterPos.y - Length_Hour * Cos(st.wHour * PAI / 6 + st.wMinute * PAI / 360)) As Long + MoveToEx(hdc, CenterPos.x, CenterPos.y, ByVal NULL) + LineTo(hdc, pos.x, pos.y) + SelectObject(hdc,hOldPen) + DeleteObject(hPen) + + '長針 + hPen=CreatePen(PS_SOLID,2,RGB(255,0,0)) + hOldPen=SelectObject(hdc,hPen) + pos.x = (CenterPos.x + Length_Minute * Sin(st.wMinute * PAI / 30 + st.wSecond * PAI / 1800)) As Long + pos.y = (CenterPos.y - Length_Minute * Cos(st.wMinute * PAI / 30 + st.wSecond * PAI / 1800)) As Long + MoveToEx(hdc, CenterPos.x, CenterPos.y, ByVal NULL) + LineTo(hdc, pos.x, pos.y) + SelectObject(hdc, hOldPen) + DeleteObject(hPen) + + '秒針 + hPen=GetStockObject(BLACK_PEN) + hOldPen=SelectObject(hdc,hPen) + pos.x = (CenterPos.x + Length_Second * Sin(st.wSecond * PAI / 30)) As Long + pos.y = (CenterPos.y - Length_Second * Cos(st.wSecond * PAI / 30)) As Long + MoveToEx(hdc, CenterPos.x, CenterPos.y, ByVal NULL) + LineTo(hdc, pos.x, pos.y) + SelectObject(hdc,hOldPen) + End Sub + + timer As Timer + st As SYSTEMTIME +' bTopMost As Long +End Class + +Control.Initialize(GetModuleHandle(0)) +Dim f = New WatchForm +f.CreateForm() +Application.Run(f) Index: /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab (revision 678) +++ /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab (revision 679) @@ -1,4 +1,5 @@ 'Classes/ActiveBasic/Windows/UI/Control.ab +#require #require #require Index: /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Timer.ab =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Timer.ab (revision 678) +++ /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Timer.ab (revision 679) @@ -1,2 +1,4 @@ + +#require /* @brief タイマ @@ -10,14 +12,9 @@ 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,11 +22,11 @@ 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,18 +49,22 @@ 'オーバーロードされます。 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,11 +81,4 @@ 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,26 +94,23 @@ 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 Index: /trunk/ab5.0/ablib/src/api_gdi.sbp =================================================================== --- /trunk/ab5.0/ablib/src/api_gdi.sbp (revision 678) +++ /trunk/ab5.0/ablib/src/api_gdi.sbp (revision 679) @@ -788,4 +788,19 @@ 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