はるか昔、あてずっぽうに作ったモノ。フォーム(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
|