#require #require #require #require #require #require #require #require #require #require #require #require #require #require #require #require #require #require #require /*! @file @brief 「Win32プログラミング講座 〜 Step32. アナログ時計を作る 〜」のAB5 GDI+移植版 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)) AddDestroy(AddressOf(OnDestroy)) 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) Dim gsi = [1] As GdiplusStartupInput GdiplusStartup(gdipToken, gsi, 0) End Sub Sub OnDestroy(sender As Object, e As EventArgs) ' GdiplusShutdown(gdipToken) 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) Imports System.Drawing Dim pos As PointF Dim hdc = e.Handle Dim g = Graphics.FromHDC(hdc) g.Clear(&hffffffff) Dim rc = This.ClientRect Dim CenterPos As PointF '針の中心位置 '針の中心位置 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 pos.X = (CenterPos.X + Length_Hour * Sin(st.wHour * PAI / 6 + st.wMinute * PAI / 360)) As Single pos.Y = (CenterPos.Y - Length_Hour * Cos(st.wHour * PAI / 6 + st.wMinute * PAI / 360)) As Single Dim pen = New Pen(&hffff6400, 5.0) g.DrawLine(pen, CenterPos, pos) '長針 pos.X = (CenterPos.X + Length_Minute * Sin(st.wMinute * PAI / 30 + st.wSecond * PAI / 1800)) As Single pos.Y = (CenterPos.Y - Length_Minute * Cos(st.wMinute * PAI / 30 + st.wSecond * PAI / 1800)) As Single pen.Color = &hffff0000 pen.Width = 2.0 g.DrawLine(pen, CenterPos, pos) '秒針 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 pen.Color = &hff000000 pen.Width = 1.0 g.DrawLine(pen, CenterPos, pos) pen.Dispose() g.Dispose() End Sub timer As Timer st As SYSTEMTIME bTopMost As Long gdipToken As ULONG_PTR End Class Control.Initialize(GetModuleHandle(0)) Dim f = New WatchForm f.CreateForm() Application.Run(f) End