用VB编写简单的时钟程序（有时、分、秒针转动）

　　 

原贴地址： http://bbs.bc-cn.net/bbs/dispbbs.asp?boardID=6&ID=18083&page=1

'/////////////////////////////////
'小闹钟示例
'Written By griefforyou
'在窗体中添加一个Timer控件，将Interval设为1000以下。
'////////////////////////////////

Option Explicit

Const PI = 3.1415926
Dim BaseX As Integer, BaseY As Integer, R As Integer
Dim r1 As Integer, r2 As Integer, r3 As Integer

Private Sub Form_Load()
    Me.ScaleMode = 3
    Me.AutoRedraw = True
    
    If Me.Width < 3000 Then Me.Width = 3000
    If Me.Height < 3000 Then Me.Height = 3000
    
End Sub

Private Sub Init()
Dim i As Integer

    BaseX = Me.ScaleWidth / 2
    BaseY = Me.ScaleHeight / 2
    
    R = IIf(BaseX > BaseY, BaseY * 0.8, BaseY * 0.8)
    r1 = R * 0.2
    r2 = R * 0.1
    r3 = R * 0.05

    For i = 0 To 360 Step 6
        
        If i Mod 30 = 0 Then    '时
            Me.DrawWidth = 2
            DrawLine BaseX + (R - 3) * Sin(i * PI / 180), BaseY - (R - 3) * Cos(i * PI / 180), BaseX + (R - 8) * Sin(i * PI / 180), BaseY - (R - 8) * Cos(i * PI / 180), 3
        Else                    '分
            Me.DrawWidth = 2
            Me.PSet (BaseX + (R - 3) * Sin(i * PI / 180), BaseY - (R - 3) * Cos(i * PI / 180))
        End If
    Next
    
    Me.DrawWidth = 1
    Me.Circle (BaseX, BaseY), R
End Sub

'绘制指针
Private Sub DrawClock()
Dim Second As Integer
Dim Minute As Integer
Dim Hours As Integer

    Second = DatePart("s", Time)
    Minute = DatePart("n", Time)
    Hours = DatePart("h", Time)
    If Hours > 12 Then
        Hours = Hours - 12
    End If

    Me.DrawWidth = 1
    Me.Circle (BaseX, BaseY), 4

    DrawLine BaseX - r1 * Sin(Second * PI / 30), BaseY + r1 * Cos(Second * PI / 30), BaseX + (R - 10) * Sin(Second * PI / 30), BaseY - (R - 10) * Cos(Second * PI / 30), 0
    DrawLine BaseX - r2 * Sin(Minute * PI / 30), BaseY + r2 * Cos(Minute * PI / 30), BaseX + R * 0.8 * Sin(Minute * PI / 30), BaseY - R * 0.8 * Cos(Minute * PI / 30), 1
    DrawLine BaseX - r3 * Sin((Hours + Minute / 60) * PI / 6), BaseY + r3 * Cos((Hours + Minute / 60) * PI / 6), BaseX + R * 0.6 * Sin((Hours + Minute / 60) * PI / 6), BaseY - R * 0.6 * Cos((Hours + Minute / 60) * PI / 6), 2
End Sub

'画线函数
Private Sub DrawLine(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, Flag As Integer)
Static OldSX1 As Integer, OldSX2 As Integer, OldSY1 As Integer, OldSY2 As Integer
Static OldMX1 As Integer, OldMX2 As Integer, OldMY1 As Integer, OldMY2 As Integer
Static OldHX1 As Integer, OldHX2 As Integer, OldHY1 As Integer, OldHY2 As Integer
    Select Case Flag
        Case 0
            Me.DrawWidth = 1
            Me.Line (OldSX1, OldSY1)-(OldSX2, OldSY2), Me.BackColor
            Me.Line (x1, y1)-(x2, y2)
            OldSX1 = x1
            OldSX2 = x2
            OldSY1 = y1
            OldSY2 = y2
        Case 1
            Me.DrawWidth = 2
            Me.Line (OldMX1, OldMY1)-(OldMX2, OldMY2), Me.BackColor
            Me.Line (x1, y1)-(x2, y2)
            OldMX1 = x1
            OldMX2 = x2
            OldMY1 = y1
            OldMY2 = y2
        Case 2
            Me.DrawWidth = 3
            Me.Line (OldHX1, OldHY1)-(OldHX2, OldHY2), Me.BackColor
            Me.Line (x1, y1)-(x2, y2)
            OldHX1 = x1
            OldHX2 = x2
            OldHY1 = y1
            OldHY2 = y2
        Case Else
            Me.Line (x1, y1)-(x2, y2)
    End Select
End Sub

Private Sub Form_Resize()
    Me.Cls
    Call Init
End Sub

Private Sub Timer1_Timer()
    Call DrawClock
End Sub

原文转自：http://www.ltesting.net