● アナログ時計を作ってみる ●

はるか昔、あてずっぽうに作ったモノ。フォーム(Form1)にピクチャーボックス(picScreen)とタイマーコントロール(Timer1)を貼り付けて、以下のコードを書く。たったそれだけ。
Private Const Radian As Double = 0.01745329251944  'ラジアン

Private Const CENTER_XPOS = 50
Private Const CENTER_YPOS = 50

Private Const LONG_HAND = CENTER_XPOS - 3        '長針の長さ
Private Const SHORT_HAND = CENTER_XPOS - 13      '短針の長さ
Private Const SECOND_HAND = CENTER_XPOS - 8      '秒針の長さ

Private Const MINUTE_MARK_LEN = CENTER_XPOS - 2  '1〜12のマーク位置

Private Sub Form_Load()
    Form1.ScaleMode = vbPixels
    Timer1.Interval = 100
    With picScreen
        .ScaleMode = vbPixels
        .Width = CENTER_XPOS * 2
        .Height = CENTER_YPOS * 2
        .AutoRedraw = True
        .BorderStyle = 0
        .BackColor = vbBlack
    End With
End Sub

Private Sub Timer1_Timer()
    DrawClock
End Sub

Private Sub DrawClock()
    Dim i As Long
    Dim NewXPos&, NewYPos As Long
    Dim cHour&, cMinute&, cSecond As Long
    Dim Angle As Long
    Dim AddAngleShortHand As Long
    Dim NowTime As String

    '時・分・秒を取得
    NowTime = Format$(Now, "hhmmss")
    cHour = CLng(Mid$(NowTime, 1, 2))
    cMinute = CLng(Mid$(NowTime, 3, 2))
    cSecond = CLng(Mid$(NowTime, 5))

    '裏画面クリア
    picScreen.Cls

    '1から12の位置に点を打つ
    For i = 0 To 11
        Angle = i * 30
        NewXPos = CLng(Cos(Angle * Radian) * MINUTE_MARK_LEN) + CENTER_XPOS
        NewYPos = CLng(Sin(Angle * Radian) * MINUTE_MARK_LEN) + CENTER_YPOS
        picScreen.PSet (NewXPos, NewYPos), RGB(0, 255, 255)
    Next i

    '長針位置
    Angle = cMinute * 6 - 90
    NewXPos = CLng(Cos(Angle * Radian) * LONG_HAND) + CENTER_XPOS
    NewYPos = CLng(Sin(Angle * Radian) * LONG_HAND) + CENTER_YPOS

    picScreen.Line (CENTER_XPOS, CENTER_YPOS)-(NewXPos, NewYPos), RGB(255, 0, 0)

    '短針位置
    '分によって短針の位置を変える
    Select Case cMinute
        Case 0 To 9
            AddAngleShortHand = 0
        Case 10 To 19
            AddAngleShortHand = 5
        Case 20 To 29
            AddAngleShortHand = 10
        Case 30 To 39
            AddAngleShortHand = 15
        Case 40 To 49
            AddAngleShortHand = 20
        Case 50 To 59
            AddAngleShortHand = 25
    End Select
    Angle = cHour * 30 - 90 + AddAngleShortHand
    NewXPos = CLng(Cos(Angle * Radian) * SHORT_HAND) + CENTER_XPOS
    NewYPos = CLng(Sin(Angle * Radian) * SHORT_HAND) + CENTER_YPOS

    picScreen.Line (CENTER_XPOS, CENTER_YPOS)-(NewXPos, NewYPos), RGB(0, 255, 0)

    '秒針位置
    Angle = cSecond * 6 - 90
    NewXPos = CLng(Cos(Angle * Radian) * SECOND_HAND) + CENTER_XPOS
    NewYPos = CLng(Sin(Angle * Radian) * SECOND_HAND) + CENTER_YPOS

    '秒針描画
    picScreen.Line (CENTER_XPOS, CENTER_YPOS)-(NewXPos, NewYPos), RGB(255, 0, 255)
End Sub

戻る