アナログ時計 <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