アナログ時計を作るには

アナログ時計を作ってみます。
キーワードは「AngleArc()関数」です。
AngleArc()関数は中心点と半径を指定して円・円弧を描画します。
描画にはデバイスコンテキストに選択されているペンを使用します。
サンプルでは秒針だけを描画していますが、ちょっと改造すれば長針・短針も描画できます。

実行時の様子


'ラインセグメント､および円弧を描画する
Private Declare Function AngleArc Lib "gdi32.dll" _
    (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dwRadius As Long, _
    ByVal eStartAngle As Single, ByVal eSweepAngle As Single) As Long
'現在の位置を変更する
Private Declare Function MoveToEx Lib "gdi32.dll" _
    (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpCoord As Long) As Long
'現在の位置から終点までを直線で描画する
Private Declare Function LineTo Lib "gdi32.dll" _
    (ByVal hdc As Long, ByVal nXEnd As Long, ByVal nYEnd As Long) As Long

Dim hBrush As Long, hPen As Long

Private Sub Form_Load()
    Dim bgColor As Long
    Me.Picture1.BackColor = vbWhite             '背景色を白にする
    Me.Picture1.ScaleMode = 3                   'ピクセルモード
    
    Me.Picture1.ForeColor = vbBlue              'ペンの色
    Me.Timer1.Interval = 1000
End Sub


Private Sub Timer1_Timer()
    '現在の秒数を円グラフで表現する
    Dim x, y
    With Me.Picture1
        .Cls                                    'ピクチャーボックスを全部消す
        .Refresh                                'リフレッシュ
        x = .ScaleWidth / 2                     '中心点
        y = .ScaleHeight / 2
        Call MoveToEx(.hdc, x, y - (x - 25), 0) '始点
        Call AngleArc(.hdc, x, y, x - 25, 90, -(Second(Now) / 60) * 360)
        Call LineTo(.hdc, x, y)
        
        .CurrentX = x - 20
        .CurrentY = .ScaleHeight - 20
        Me.Picture1.Print Now
    End With
End Sub

ダウンロード