自制仿真时钟

todaynew

　　前天写了一个日历的实例，想想光看日子总不行，俗话说光阴似箭，日月如梭。特别是在金融危机导致帝国主义一天天烂下去，社会主义一天天好起来的关键时期，如果你不争分夺秒，你手中的股票明天就可能一文不值，你刚买的房子明天可能就会跌去一半。于是乎，你便会觉得时间不能用年月日来计算，而应该以时分秒来感受。于是你也就体会到，现在人们不大愿意戴手表是一种错误。为了弥补这个错误，你就需要观看此帖了。因为在这里，你可以得到并推荐给那些对时间敏感的人们，一款经久耐用，而又免费的钟表。





-----------------------------------------------------------------------------

Option Compare Database
Private Const R As Single = 1000
Private Const PI As Single = 3.14159265357
Private x0 As Single, y0 As Single
Private myline(1 To 6) As Line
Private x(1 To 12) As Single, y(1 To 12) As Single
Private W As Single, H As Single
Dim H秒 As Single, W秒 As Single
Dim H分 As Single, W分 As Single
Dim H时 As Single, W时 As Single
Dim i As Long, j As Long

Private Sub Form_Open(Cancel As Integer)
    Set myline(1) = Me.秒针13
    Set myline(2) = Me.秒针24
    Set myline(3) = Me.分针13
    Set myline(4) = Me.分针24
    Set myline(5) = Me.时针13
    Set myline(6) = Me.时针24

    x0 = R * 1.2
    y0 = R * 1.2
    W = Me.L12.Width / 2
    H = Me.L12.Height / 2
    Me.圆心.Move x0 + Me.圆心.Width / 2, y0 + Me.圆心.Height / 2
    '设置表盘
    x(12) = x0
    y(12) = H
    Me.L12.Move x(12), y(12)
    x(1) = x0 + (x0 - W) * Sin(2 * PI / 60 * 5)
    y(1) = y0 - (y0 - H) * Cos(2 * PI / 60 * 5)
    Me.L1.Move x(1), y(1)
    x(2) = x0 + (x0 - W) * Sin(2 * PI / 60 * 10)
    y(2) = y0 - (y0 - H) * Cos(2 * PI / 60 * 10)
    Me.L2.Move x(2), y(2)
    x(3) = x0 + (x0 - W) * Sin(2 * PI / 60 * 15)
    y(3) = y0 - (y0 - H) * Cos(2 * PI / 60 * 15)
    Me.L3.Move x(3), y(3)
    x(4) = x0 + (x0 - W) * Sin(2 * PI / 60 * 10)
    y(4) = y0 + (y0 - H) * Cos(2 * PI / 60 * 10)
    Me.L4.Move x(4), y(4)
    x(5) = x0 + (x0 - W) * Sin(2 * PI / 60 * 5)
    y(5) = y0 + (y0 - H) * Cos(2 * PI / 60 * 5)
    Me.L5.Move x(5), y(5)
    x(6) = x0
    y(6) = 2 * y0 - H
    Me.L6.Move x(6), y(6)
    x(7) = x0 - (x0 - W) * Sin(2 * PI / 60 * 5)
    y(7) = y0 + (y0 - H) * Cos(2 * PI / 60 * 5)
    Me.L7.Move x(7), y(7)
    x(8) = x0 - (x0 - W) * Sin(2 * PI / 60 * 10)
    y(8) = y0 + (y0 - H) * Cos(2 * PI / 60 * 10)
    Me.L8.Move x(8), y(8)
    x(9) = x0 - (x0 - W) * Sin(2 * PI / 60 * 15)
    y(9) = y0 + (y0 - H) * Cos(2 * PI / 60 * 15)
    Me.L9.Move x(9), y(9)
    x(10) = x0 - (x0 - W) * Sin(2 * PI / 60 * 10)
    y(10) = y0 - (y0 - H) * Cos(2 * PI / 60 * 10)
    Me.L10.Move x(10), y(10)
    x(11) = x0 - (x0 - W) * Sin(2 * PI / 60 * 5)
    y(11) = y0 - (y0 - H) * Cos(2 * PI / 60 * 5)
    Me.L11.Move x(11), y(11)
    '设置秒、分、时针属性
    With myline(1)
    .BorderStyle = 1
    .BorderWidth = 1
    .BorderColor = RGB(255, 0, 0)
    End With
    With myline(2)
    .BorderStyle = 1
    .BorderWidth = 1
    .BorderColor = RGB(255, 0, 0)
    End With
    With myline(3)
    .BorderStyle = 1
    .BorderWidth = 1
    .BorderColor = RGB(0, 0, 0)
    End With
    With myline(4)
    .BorderStyle = 1
    .BorderWidth = 1
    .BorderColor = RGB(0, 0, 0)
    End With
    With myline(5)
    .BorderStyle = 1
    .BorderWidth = 1.5
    .BorderColor = RGB(0, 0, 0)
    End With
    With myline(6)
    .BorderStyle = 1
    .BorderWidth = 1.5
    .BorderColor = RGB(0, 0, 0)
    End With
    '使秒分时针不可见
    myline(1).Visible = False
    myline(2).Visible = False
    myline(3).Visible = False
    myline(4).Visible = False
    myline(5).Visible = False
    myline(6).Visible = False
End Sub

Private Sub Form_Timer()
Static t秒 As Long, t分 As Long, t时 As Long
    Me.时间.Caption = Format(Now(), "hh:mm:ss")
    Me.日期.Caption = Format(Now(), "yy/mm/dd")
    t秒 = Second(Now())
    t分 = Minute(Now())
    t时 = Hour(Now())
    H秒 = R * Sin(2 * PI / 60 * (-1) * t秒)
    W秒 = R * Cos(2 * PI / 60 * (-1) * t秒)
    H分 = 0.95 * R * Sin(2 * PI / 60 * (-1) * (t分 + t秒 / 60))
    W分 = 0.95 * R * Cos(2 * PI / 60 * (-1) * (t分 + t秒 / 60))
    H时 = 0.8 * R * Sin(2 * PI / 12 * (-1) * (t时 + t分 / 60))
    W时 = 0.8 * R * Cos(2 * PI / 12 * (-1) * (t时 + t分 / 60))
    '秒针轨迹
    Select Case t秒
        Case 0 To 14
            myline(2).Visible = False
            myline(1).Visible = True
            myline(1).Move x0 + W, y0 + H - W秒, -H秒, W秒
        Case 15 To 29
            myline(1).Visible = False
            myline(2).Visible = True
            myline(2).Move x0 + W, y0 + H, -H秒, -W秒
        Case 30 To 44
            myline(2).Visible = False
            myline(1).Visible = True
            myline(1).Move x0 + W - H秒, y0 + W, H秒, -W秒
        Case 45 To 59
            myline(1).Visible = False
            myline(2).Visible = True
            myline(2).Move x0 + W - H秒, y0 + H - W秒, H秒, W秒
    End Select
    '分针轨迹
    Select Case t分
        Case 0 To 14
            myline(4).Visible = False
            myline(3).Visible = True
            myline(3).Move x0 + W, y0 + H - W分, -H分, W分
        Case 15 To 29
            myline(3).Visible = False
            myline(4).Visible = True
            myline(4).Move x0 + W, y0 + H, -H分, -W分
        Case 30 To 44
            myline(4).Visible = False
            myline(3).Visible = True
            myline(3).Move x0 + W - H分, y0 + W, H分, -W分
        Case 45 To 59
            myline(3).Visible = False
            myline(4).Visible = True
            myline(4).Move x0 + W - H分, y0 + H - W分, H分, W分
    End Select
    '时针轨迹
    Select Case t时
        Case 0 To 2, 12 To 14
            myline(6).Visible = False
            myline(5).Visible = True
            myline(5).Move x0 + W, y0 + H - W时, -H时, W时
        Case 3 To 5, 15 To 17
            myline(5).Visible = False
            myline(6).Visible = True
            myline(6).Move x0 + W, y0 + H, -H时, -W时
        Case 6 To 8, 18 To 20
            myline(6).Visible = False
            myline(5).Visible = True
            myline(5).Move x0 + W - H时, y0 + W, H时, -W时
        Case 9 To 11, 21 To 23
            myline(5).Visible = False
            myline(6).Visible = True
            myline(6).Move x0 + W - H时, y0 + H - W时, H时, W时
    End Select
End Sub

ACMAIN_CHM

******************
*  一切皆有可能  *
******************
.
ACMAIN - Access论坛回贴准则（个人）.
.
同一贴子不回复第二次

todaynew

******************
*  一切皆有可能  *
******************
.
ACMAIN - Access论坛回贴准则（个人）.
.
同一贴子不回复第二次

ACMAIN_CHM 发表于 2009-3-30 19:43

82077802

thanks

蓝天8390

真棒

Henry D. Sy

支持

Grant

绝对支持楼主的爱迪生精神

yanwei82123300

真棒

13555609005

真棒

chuang0321

鼓励一下