VBA下完全功能的Timer类

gxp98765

不错的东东 顶下下

HHAAMM

这个类好像还是多进程的
写了个测试文件(如图)，很不错，对于开发有许多物体都在移动的游戏很有用

HHAAMM

Private WithEvents cTimer1 As 类1
Private WithEvents cTimer2 As 类1
Private WithEvents cTimer3 As 类1
Private WithEvents cTimer4 As 类1
Private WithEvents cTimer5 As 类1
Private WithEvents cTimer6 As 类1
Private WithEvents cTimer7 As 类1
Private WithEvents cTimer8 As 类1
Private WithEvents cTimer9 As 类1

Private Sub cTimer1_Timer()
On Error Resume Next
ActiveSheet.Shapes("Oval 1").Top = ActiveSheet.Shapes("Oval 1").Top + 1
If ActiveSheet.Shapes("Oval 1").Top > 370 Then ActiveSheet.Shapes("Oval 1").Top = 0
End Sub
Private Sub cTimer2_Timer()
On Error Resume Next
ActiveSheet.Shapes("Oval 2").Top = ActiveSheet.Shapes("Oval 2").Top + 2
If ActiveSheet.Shapes("Oval 2").Top > 370 Then ActiveSheet.Shapes("Oval 2").Top = 0
End Sub
Private Sub cTimer3_Timer()
On Error Resume Next
ActiveSheet.Shapes("Oval 3").Top = ActiveSheet.Shapes("Oval 3").Top + 3
If ActiveSheet.Shapes("Oval 3").Top > 370 Then ActiveSheet.Shapes("Oval 3").Top = 0
End Sub
Private Sub cTimer4_Timer()
On Error Resume Next
ActiveSheet.Shapes("Oval 4").Top = ActiveSheet.Shapes("Oval 4").Top + 4
If ActiveSheet.Shapes("Oval 4").Top > 370 Then ActiveSheet.Shapes("Oval 4").Top = 0
End Sub
Private Sub cTimer5_Timer()
On Error Resume Next
ActiveSheet.Shapes("Oval 5").Top = ActiveSheet.Shapes("Oval 5").Top + 5
If ActiveSheet.Shapes("Oval 5").Top > 370 Then ActiveSheet.Shapes("Oval 5").Top = 0
End Sub
Private Sub cTimer6_Timer()
On Error Resume Next
ActiveSheet.Shapes("Oval 6").Top = ActiveSheet.Shapes("Oval 6").Top + 6
If ActiveSheet.Shapes("Oval 6").Top > 370 Then ActiveSheet.Shapes("Oval 6").Top = 0
End Sub
Private Sub cTimer7_Timer()
On Error Resume Next
ActiveSheet.Shapes("Oval 7").Top = ActiveSheet.Shapes("Oval 7").Top + 7
If ActiveSheet.Shapes("Oval 7").Top > 370 Then ActiveSheet.Shapes("Oval 7").Top = 0
End Sub
Private Sub cTimer8_Timer()
On Error Resume Next
ActiveSheet.Shapes("Oval 8").Top = ActiveSheet.Shapes("Oval 8").Top + 8
If ActiveSheet.Shapes("Oval 8").Top > 370 Then ActiveSheet.Shapes("Oval 8").Top = 0
End Sub
Private Sub cTimer9_Timer()
On Error Resume Next
ActiveSheet.Shapes("Oval 9").Top = ActiveSheet.Shapes("Oval 9").Top + 9
If ActiveSheet.Shapes("Oval 9").Top > 370 Then ActiveSheet.Shapes("Oval 9").Top = 0
End Sub

Sub xx()
Set cTimer1 = New 类1
Set cTimer2 = New 类1
Set cTimer3 = New 类1
Set cTimer4 = New 类1
Set cTimer5 = New 类1
Set cTimer6 = New 类1
Set cTimer7 = New 类1
Set cTimer8 = New 类1
Set cTimer9 = New 类1
cTimer1.Interval = 1
cTimer2.Interval = 2
cTimer3.Interval = 3
cTimer4.Interval = 4
cTimer5.Interval = 5
cTimer6.Interval = 6
cTimer7.Interval = 7
cTimer8.Interval = 8
cTimer9.Interval = 9
cTimer1.Enabled = True
cTimer2.Enabled = True
cTimer3.Enabled = True
cTimer4.Enabled = True
cTimer5.Enabled = True
cTimer6.Enabled = True
cTimer7.Enabled = True
cTimer8.Enabled = True
cTimer9.Enabled = True
End Sub

Sub yy()
cTimer1.Enabled = False
Set cTimer1 = Nothing
cTimer2.Enabled = False
Set cTimer2 = Nothing
cTimer3.Enabled = False
Set cTimer3 = Nothing
cTimer4.Enabled = False
Set cTimer4 = Nothing
cTimer5.Enabled = False
Set cTimer5 = Nothing
cTimer6.Enabled = False
Set cTimer6 = Nothing
cTimer7.Enabled = False
Set cTimer7 = Nothing
cTimer8.Enabled = False
Set cTimer8 = Nothing
cTimer9.Enabled = False
Set cTimer9 = Nothing
End Sub
Sub zz()
ActiveSheet.Shapes("Oval 1").Top = 0
ActiveSheet.Shapes("Oval 2").Top = 0
ActiveSheet.Shapes("Oval 3").Top = 0
ActiveSheet.Shapes("Oval 4").Top = 0
ActiveSheet.Shapes("Oval 5").Top = 0
ActiveSheet.Shapes("Oval 6").Top = 0
ActiveSheet.Shapes("Oval 7").Top = 0
ActiveSheet.Shapes("Oval 8").Top = 0
ActiveSheet.Shapes("Oval 9").Top = 0
End Sub

winland

原帖由 HHAAMM 于 2010-9-25 14:33 发表
Private WithEvents cTimer1 As 类1
Private WithEvents cTimer2 As 类1
Private WithEvents cTimer3 As 类1
Private WithEvents cTimer4 As 类1
Private WithEvents cTimer5 As 类1
Private WithEvents cTimer ...

哈哈，以前刚放the Matrix的时候，在VB中学做那种绿色字符往下掉的屏幕保护，就用的这种方法。

lin82

好点子，谢谢！

mingdegang

谢谢楼主分享，先学习学习

jxnu

收藏，研究下。

hzs207

谢谢分享！

HHAAMM

思路还有些问题，已经想明白了，明天改

zm0115

水平不够，也来顶一下。