/*! @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)