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