Office中国论坛/Access中国论坛

标题: 自制仿真时钟 [打印本页]

作者: todaynew 时间: 2009-3-30 18:23
标题: 自制仿真时钟
本帖最后由 todaynew 于 2009-3-30 19:46 编辑

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

[attach]37018[/attach]

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

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 时间: 2009-3-30 19:43

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

作者: todaynew 时间: 2009-3-30 20:05

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

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

作者: 82077802 时间: 2009-3-30 20:16
thanks

作者: 蓝天8390 时间: 2009-3-30 20:47
真棒

作者: Henry D. Sy 时间: 2009-3-30 22:44
支持

作者: Grant 时间: 2009-3-30 22:58
绝对支持楼主的爱迪生精神

作者: yanwei82123300 时间: 2009-3-31 07:32
真棒

作者: 13555609005 时间: 2009-3-31 12:04
真棒

作者: chuang0321 时间: 2009-3-31 14:26
鼓励一下

作者: zhaofangyuan 时间: 2009-4-1 15:39
谢谢楼主!

作者: chaojianan 时间: 2009-4-1 16:21
支持，学习。

作者: todaynew 时间: 2009-4-9 19:33
谢谢同志们

作者: koutx 时间: 2009-4-9 19:42
todaynew今天又出新作了！

作者: njy6000 时间: 2009-4-9 21:11
很好的概念,我来组合到我的文件中,不会有意见吧?

作者: njy6000 时间: 2009-4-9 21:14
如果能让窗体半透明一块,镶上您的时钟,我想很漂亮的.
不过半透明一块我不会做!!!!

作者: todaynew 时间: 2009-4-11 17:08

很好的概念,我来组合到我的文件中,不会有意见吧?
njy6000 发表于 2009-4-9 21:11

没意见。

作者: todaynew 时间: 2009-4-11 17:08

如果能让窗体半透明一块,镶上您的时钟,我想很漂亮的.
不过半透明一块我不会做!!!!
njy6000 发表于 2009-4-9 21:14

半透明我也不会，好像有一个帖子中有此类方法，你可以试着改造一下。

作者: 减肥 时间: 2009-4-12 11:40
支持

作者: LHB 时间: 2010-1-11 13:18
超强实例!谢谢了.

作者: greatcf 时间: 2010-1-22 20:51
谢谢

作者: c101 时间: 2010-1-22 21:51
谢谢楼主

作者: 路遥 时间: 2010-1-25 13:14
楼主的很多例子都有学习价值，而且是无私奉献，一定要支持

作者: xiangpidouzi 时间: 2010-1-25 20:51
厉害啊

作者: cszlzklibo 时间: 2010-1-26 23:20
高手啊

作者: huxinhua 时间: 2012-1-10 15:20
鼓励一下

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)