アナログ時計 <TOP>
簡易アナログ時計を作成します。
GetThreadLocale
スレッドのロケールIDを取得
SetThreadLocale
スレッドのロケールIDを設定
GetLocalTime
ローカルタイムを取得

参照
'================================================================ '= 簡易アナログ時計
'= (Clock.bas)
'================================================================
#include "Windows.bi"
Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
' スレッドのロケールIDを取得
Declare Function Api_GetThreadLocale& Lib "Kernel32" Alias "GetThreadLocale" ()
' スレッドのロケールIDを設定
Declare Function Api_SetThreadLocale& Lib "kernel32" Alias "SetThreadLocale" (ByVal Locale&)
' ローカルタイムを取得
Declare Sub Api_GetLocalTime Lib "Kernel32" Alias "GetLocalTime" (lpSytemTime As SYSTEMTIME)
' 時刻をフォーマットし、指定された地域に対応する時刻文字列を作成
Declare Function Api_GetTimeFormat& Lib "kernel32" Alias "GetTimeFormatA" (ByVal Locale&, ByVal dwFlags&, lpTime As SYSTEMTIME, ByVal lpFormat As Any, ByVal lpTimeStr$, ByVal cchTime&)
#define LOCALE_SYSTEM_DEFAULT &H400 'システムのデフォルトロケール
Var Shared Timer1 As Object
Var Shared Picture1 As Object
Var Shared Text1 As Object
Timer1.Attach GetDlgItem("Timer1")
Picture1.Attach GetDlgItem("Picture1")
Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 20
Var Shared x As Integer
Var Shared y As Integer
Var Shared w As Integer
'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
x = Picture1.GetWidth / 2
y = Picture1.GetHeight / 2
w = Picture1.GetWidth
Timer1.SetInterval 50
Timer1.Enable -1
End Sub
'================================================================
'=
'================================================================
Declare Sub Timer1_Timer edecl ()
Sub Timer1_Timer()
Var ST As SYSTEMTIME
Var fTime As String * 256
Var h As String
Var m As String
Var s As String
Var Ret As Long
If Api_GetThreadLocale <> LOCALE_SYSTEM_DEFAULT Then
Ret = Api_SetThreadLocale(LOCALE_SYSTEM_DEFAULT)
End If
Api_GetLocalTime ST
'12時間形式
Ret = Api_GetTimeFormat(0, 0, ST, "hh:mm:ss tt", fTime, Len(fTime))
h = Left$(fTime, 2)
m = Mid$(fTime, 4, 2)
s = Mid$(fTime, 7, 2)
Picture1.Cls
Picture1.SetDrawWidth 1
Picture1.Circle (x, y), w / 2 - 1, 1,,,,f,, 15
Picture1.SetDrawWidth 6
Picture1.Line (x, y)-(x + (60 * Sin(Val(h) * 3.1416 / 6)), y - (60 * Cos(Val(h) * 3.1416 / 6))),, 0
Picture1.SetDrawWidth 3
Picture1.Line (x, y)-(x + (90 * Sin(Val(m) * 3.1416 / 30)), y - (90 * Cos(Val(m) * 3.1416 / 30))),, 3
Picture1.SetDrawWidth 1
Picture1.Line (x, y)-(x + (92 * Sin(Val(s) * 3.1416 / 30)), y - (92 * Cos(Val(s) * 3.1416 / 30))),, 5
Text1.SetWindowText Left$(fTime, Ret)
End Sub
'================================================================
'=
'================================================================
While 1
WaitEvent
Wend
Stop
End