VB 中给对象计时的问题

Question

我想给一个对象计时如红绿灯  我想计算红灯亮的时间  看它亮灯是否超时···  一般我们都会有timer控件来做这件事。但是  我想计时的对象  有几十个···怎么办呢？？那么多TIMER控件会严重影响到程序效率吧？有什么有其他的办法 解决类似的问题呢？

Answer 1

一个定时器就可以了，比如你的灯是个控件数组，那么在Time事件里循环控件参数就可以了。
如：Private Sub Form_Load()
    Dim i       As Long
    Dim x       As Long
    Dim y       As Long
    Dim wCount  As Long
    Dim dwWidth As Long
    
    '========================================
    ' 注意 LED.Index 不能为空，将其设置为 0
    '========================================
    dwWidth = (15 * 12)
    wCount = (Me.Width - 15 * 6) / dwWidth
    
    Randomize
    LED(0).Tag = Int((60 * Rnd) + 0)
    If Int((2 * Rnd) + 0) Then
        LED(0).BackColor = &HFF&
    Else
        LED(0).BackColor = &HFF00&
    End If
    LED(0).Move 0, 0, dwWidth, dwWidth
    ' 动态加载99个名为LED的 PictureBox 控件
    For i = 1 To 99
        x = x + 1
        If x >= wCount Then
            x = 0
            y = y + 1
        End If
        ' 加载新的控件数组元素
        Load LED(i)
        ' 像控件数组元素的 Tag 属性随机分配一个 0-60 之间的整数
        LED(i).Tag = Int((60 * Rnd) + 0)
        
        ' 随机设置控件的背景色为红色或绿色
        If Int((2 * Rnd) + 0) Then
            LED(i).BackColor = &HFF&
        Else
            LED(i).BackColor = &HFF00&
        End If
        LED(i).Move x * dwWidth, y * dwWidth, dwWidth, dwWidth
        LED(i).Visible = True
    Next i
    
    Timer1.Interval = 100
    Timer1.Enabled = True
End SubPrivate Sub Timer1_Timer()
    Dim i       As Long
    Randomize
    For i = 0 To 99
        ' 判断每个控件当前色存活的时间是否已要完结
        If Int(LED(i).Tag) <= 1 Then
            ' 判断原来如果是红色就变绿色，是绿色就变红色
            If LED(i).BackColor = &HFF& Then
                LED(i).BackColor = &HFF00&
            Else
                LED(i).BackColor = &HFF&
            End If
            ' 重新随机给颜色设置一个存活时间
            LED(i).Tag = Int((60 * Rnd) + 0)
        Else
            LED(i).Tag = Int(LED(i).Tag) - 1
        End If
    Next i
End Sub

Answer 2

这样改一下效果更加好：
1、新建一个标准 EXE 工程
2、在窗体中放置一个 PictureBox 控件
3、设置 PictureBox 控件的名称为 LED，同时设置 Index 属性为 0
4、进入代码编辑，粘贴以下代码Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Dim LEDCount    As LongPrivate Sub Form_Load()
    Dim i           As Long
    Dim x           As Long
    Dim y           As Long
    Dim wCount      As Long
    Dim hCount      As Long
    Dim dwWidth     As Long
    Dim wRect       As RECT
    
    '========================================
    ' 注意 LED.Index 不能为空，将其设置为 0
    '========================================
    dwWidth = (15 * 12)
    
    GetClientRect Me.hwnd, wRect
    wCount = (wRect.Right * 15) / dwWidth
    hCount = (wRect.Bottom * 15) / dwWidth
    LEDCount = wCount * hCount - 1
    
    Randomize
    LED(0).Tag = Int((60 * Rnd) + 0)
    If Int((2 * Rnd) + 0) Then
        LED(0).BackColor = &HFF&
    Else
        LED(0).BackColor = &HFF00&
    End If
    LED(0).Move 0, 0, dwWidth, dwWidth
    ' 动态加载99个名为LED的 PictureBox 控件
    For i = 1 To LEDCount
        x = x + 1
        If x >= wCount Then
            x = 0
            y = y + 1
        End If
        ' 加载新的控件数组元素
        Load LED(i)
        ' 像控件数组元素的 Tag 属性随机分配一个 0-60 之间的整数
        LED(i).Tag = Int((60 * Rnd) + 0)
        
        ' 随机设置控件的背景色为红色或绿色
        If Int((2 * Rnd) + 0) Then
            LED(i).BackColor = &HFF&
        Else
            LED(i).BackColor = &HFF00&
        End If
        LED(i).Move x * dwWidth, y * dwWidth, dwWidth, dwWidth
        LED(i).Visible = True
    Next i
    
    Timer1.Interval = 1
    Timer1.Enabled = True
End SubPrivate Sub Timer1_Timer()
    Dim i       As Long
    Randomize
    For i = 0 To LEDCount
        ' 判断每个控件当前色存活的时间是否已要完结
        If Int(LED(i).Tag) <= 1 Then
            ' 判断原来如果是红色就变绿色，是绿色就变红色
            If LED(i).BackColor = &HFF& Then
                LED(i).BackColor = &HFF00&
            Else
                LED(i).BackColor = &HFF&
            End If
            ' 重新随机给颜色设置一个存活时间
            LED(i).Tag = Int((60 * Rnd) + 0)
        Else
            LED(i).Tag = Int(LED(i).Tag) - 1
        End If
    Next i
End Sub

Answer 3

没事又改了改代码，这样效果看起来漂亮点，呵呵Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Type LEDProperty
        MaxCount As Long
        NowCount As Long
        State As Long
End Type
Dim LEDCount    As Long
Dim LEDPA()     As LEDProperty
Private Sub Form_Load()
    Dim i           As Long
    Dim x           As Long
    Dim y           As Long
    Dim wCount      As Long
    Dim hCount      As Long
    Dim dwWidth     As Long
    Dim wRect       As RECT
    
    '========================================
    ' 注意 LED.Index 不能为空，将其设置为 0
    '========================================
    dwWidth = (15 * 12)
    
    GetClientRect Me.hwnd, wRect
    wCount = (wRect.Right * 15) / dwWidth
    hCount = (wRect.Bottom * 15) / dwWidth
    LEDCount = wCount * hCount - 1
    ReDim LEDPA(LEDCount)
    
    Randomize
    LEDPA(0).MaxCount = Int((60 * Rnd) + 0)
    LEDPA(0).NowCount = LEDPA(0).MaxCount
    If Int((2 * Rnd) + 0) Then
        LEDPA(0).State = 0
    Else
        LEDPA(0).State = 1
    End If
    LED(0).Move 0, 0, dwWidth, dwWidth
    LED(0).Enabled = False
    ' 动态加载99个名为LED的 PictureBox 控件
    For i = 1 To LEDCount
        x = x + 1
        If x >= wCount Then
            x = 0
            y = y + 1
        End If
        ' 加载新的控件数组元素
        Load LED(i)
        ' 像控件数组元素的 Tag 属性随机分配一个 0-60 之间的整数
        LEDPA(i).MaxCount = Int((60 * Rnd) + 0)
        LEDPA(i).NowCount = LEDPA(i).MaxCount
        
        ' 随机设置控件的背景色为红色或绿色
        If Int((2 * Rnd) + 0) Then
            LED(i).BackColor = &HFF&
            LEDPA(i).State = 0
        Else
            LED(i).BackColor = &HFF00&
            LEDPA(i).State = 1
        End If
        LED(i).Move x * dwWidth, y * dwWidth, dwWidth, dwWidth
        LED(i).Visible = True
        LED(i).Enabled = False
    Next i
    
    Timer1.Interval = 1
    Timer1.Enabled = True
End SubPrivate Sub Timer1_Timer()
    Dim i           As Long
    Dim lngColor1   As Long
    Dim lngColor2   As Long
    Dim by1Red      As Long
    Dim by1Green    As Long
    Dim by1Blue     As Long
    Dim by2Red      As Long
    Dim by2Green    As Long
    Dim by2Blue     As Long
    Dim cRed        As Long
    Dim cGreen      As Long
    Dim cBlue       As Long
    Dim AP          As Double
    
    Dim 比例
    Randomize
    For i = 0 To LEDCount
        ' 判断每个控件当前色存活的时间是否已要完结
        If LEDPA(i).NowCount <= 1 Then
            ' 判断原来如果是红色就变绿色，是绿色就变红色
            If LEDPA(i).State = 0 Then
                LED(i).BackColor = &HFF&
                LEDPA(i).State = 1
            Else
                LED(i).BackColor = &HFF00&
                LEDPA(i).State = 0
            End If
            ' 重新随机给颜色设置一个存活时间
            LEDPA(i).MaxCount = Int((100 * Rnd) + 0)
            LEDPA(i).NowCount = LEDPA(i).MaxCount
        Else
            If LEDPA(i).State = 0 Then
                lngColor1 = &HFF&
                lngColor2 = &HFF00&
            Else
                lngColor1 = &HFF00&
                lngColor2 = &HFF&
            End If
            by1Red = lngColor1 And &HFF: lngColor1 = Int(lngColor1 / (2 ^ 8))
            by1Green = lngColor1 And &HFF: lngColor1 = Int(lngColor1 / (2 ^ 8))
            by1Blue = lngColor1 And &HFF
            
            by2Red = lngColor2 And &HFF: lngColor2 = Int(lngColor2 / (2 ^ 8))
            by2Green = lngColor2 And &HFF: lngColor2 = Int(lngColor2 / (2 ^ 8))
            by2Blue = lngColor2 And &HFF
            
            AP = 255 / LEDPA(i).MaxCount
            
            cRed = by1Red + Round(((by2Red - by1Red) / 255) * (AP * LEDPA(i).NowCount))
            cGreen = by1Green + Round(((by2Green - by1Green) / 255) * (AP * LEDPA(i).NowCount))
            cBlue = by1Blue + Round(((by2Blue - by1Blue) / 255) * (AP * LEDPA(i).NowCount))
            
            cRed = IIf(cRed > 255, 255, IIf(cRed < 0, 0, cRed))
            cGreen = IIf(cGreen > 255, 255, IIf(cGreen < 0, 0, cGreen))
            cBlue = IIf(cBlue > 255, 255, IIf(cBlue < 0, 0, cBlue))
            
            LED(i).BackColor = RGB(cRed, cGreen, cBlue)
            LEDPA(i).NowCount = LEDPA(i).NowCount - 1
        End If
    Next i
End Sub
注意：窗口不要太大，不然启动的时候会慢一点

Answer 4

写了个使用对象思路来管理的例子.里面有两种实现方式,一种是使用集合来存储对象,一种是使用继承,经测试,继承的性能更好,毕竟是前期绑定.两种方式关键代码如下:'集合方式
Option ExplicitPrivate Declare Function GetTickCount Lib "kernel32.dll" () As LongDim oFlashs As Collection           '使用集合来存储每个对象Private Sub Form_Load()
    Dim I As Long, J As cCir, K As cPane
    
    Set oFlashs = New Collection
    
    For I = 0 To 499                            '圆与方框各500个
        Set J = New cCir
        With J
            .Color1 = vbRed
            .Color2 = vbBlue
            .Time1 = Int(Rnd * 1000 + 1000)     '随机时间
            .Time2 = Int(Rnd * 1000 + 2000)
            .X = Int(Rnd * Picture1.Width)      '随机位置
            .Y = Int(Rnd * Picture1.Height)
            Set .PicObject = Picture1           '传入绘图对象
        End With
        oFlashs.Add J                           '添加到集合
    Next
    
    For I = 500 To 999
        Set K = New cPane
        With K
            .Color1 = vbBlack
            .Color2 = vbWhite
            .Time1 = Int(Rnd * 300 + 200)
            .Time2 = Int(Rnd * 400 + 300)
            .X = Int(Rnd * Picture1.Width)
            .Y = Int(Rnd * Picture1.Height)
            Set .PicObject = Picture1
        End With
        oFlashs.Add K
    Next
End SubPrivate Sub Command1_Click()
    Timer1.Enabled = Not Timer1.Enabled
End SubPrivate Sub Timer1_Timer()
    Static FPS As Long, K As Long, L As Long
    Dim I As Long, J As Long
    
    J = GetTickCount
    Picture1.Cls
    For I = 1 To oFlashs.Count
        Call oFlashs.Item(I).DrawObject(J)      '绘图时,传入当前时间,对象自己决定当前绘制状态.由于后期绑定,性能有影响.
    Next
    
    If GetTickCount - K > 1000 Then
        K = GetTickCount
        L = FPS
        FPS = 0
    End If
    Picture1.CurrentX = 0
    Picture1.CurrentY = 0
    Picture1.Print "FPS = " & L & ",总对象数量=" & I - 1
    FPS = FPS + 1
End Sub
'继承方式
Option ExplicitPrivate Declare Function GetTickCount Lib "kernel32.dll" () As LongDim oFlashs() As cInterFace         '声明为接口类,则此处已是前期绑定.Private Sub Form_Load()
    Dim I As Long
    
    ReDim oFlashs(999)          '一共1000个对象
    
    For I = 0 To 499
        Set oFlashs(I) = New cCir               '将接口实例化为一个已继承此接口的对象
        With oFlashs(I)
            .Color1 = vbRed
            .Color2 = vbBlue
            .Time1 = Int(Rnd * 1000 + 1000)     '随机时间
            .Time2 = Int(Rnd * 1000 + 2000)
            .X = Int(Rnd * Picture1.Width)      '随机位置
            .Y = Int(Rnd * Picture1.Height)
            Set .PicObject = Picture1           '绘图对象
        End With
    Next
    
    For I = 500 To 999
        Set oFlashs(I) = New cPane
        With oFlashs(I)
            .Color1 = vbBlack
            .Color2 = vbWhite
            .Time1 = Int(Rnd * 300 + 200)
            .Time2 = Int(Rnd * 400 + 300)
            .X = Int(Rnd * Picture1.Width)
            .Y = Int(Rnd * Picture1.Height)
            Set .PicObject = Picture1
        End With
    Next
End SubPrivate Sub Command1_Click()
    Timer1.Enabled = Not Timer1.Enabled
End SubPrivate Sub Timer1_Timer()
    Static FPS As Long, K As Long, L As Long
    Dim I As Long, J As Long
    
    J = GetTickCount
    Picture1.Cls
    For I = 0 To UBound(oFlashs)
        Call oFlashs(I).DrawObject(J)           '此处的调用,已是对已知接口的调用,性能比集合更高
    Next
    
    If GetTickCount - K > 1000 Then
        K = GetTickCount
        L = FPS
        FPS = 0
    End If
    Picture1.CurrentX = 0
    Picture1.CurrentY = 0
    Picture1.Print "FPS = " & L & ",总对象数量=" & I
    FPS = FPS + 1
End Sub
完整工程下载:http://blog.m5home.com/article.asp?id=611

Answer 5

给你个基本思路，就是我上面给出的代码的思路。每个对象设为一个人。现在需要100个人按不同的频率握拳与摊手。那么最好的办法是，让每个人拿着一个秒表（时间基准），再按着领到的时间决定什么时候应该握拳，什么时候应该摊手。然后让大家的表同时开始计时，大家各自做各自的动作。我代码你仔细看看。定义了两个对象，里面代码很简单，大部分是属性，就是颜色与时间，坐标，以及绘图的对象。然后只有一个方法，就是绘图。这个方法传入的参数是一个时间基准，每个对象根据自己保存的一个“最后基准”与传入的基准进行比较，判断在某个颜色状态下经过的时间是多少，以决定是继续显示当前颜色还是切换到另一种颜色去显示。接着就是图象的样式，方框与圆。没了。但绘图的方法是直接传对象，这是为了简单。。效率却是很低的，所以1000个对象时每秒更新次数很低，在我机器上的FPS是33与22，前者是继承法，后者是集合法。对于你几十个对象的要求，完全没问题，每个对象的绘制坐标，两种颜色及相应持续的时间一设定，让定时器去循环跑就是了。

Answer 6

按照你提出的要求，我的理解搞了一个例子：利用一个trimer事件和几个数组变量完成，见下面的下载地址。
不知是不是你想要的？
下载地址：http://download.csdn.net/user/tulyroll/uploads

Answer 7

按照马哥的意思···应该是要问了 ···
我一个一个的去问···为了保证信息的实时性  就得每个人都设置一个定时器   定时自动问他是什么状态么···定时器太多了··那很悲催呀···我用timer控件数组做了  暂时没看出什么问题
但是 总觉得那么多定时器  看着不踏实···

Answer 8

难道我理解错了？说来说去，其实就是监控灯（好吧，就拿灯说事吧！）持续点亮/熄灭的时间间隔（或是变颜色的时间点）吧？
如果是，那么不管要监控多少个灯，Timer.Interval的值都可以是相同的（你亮或者不亮，时间都在流逝，不快不慢......）。这样，就可以用一个Timer在Timer.Interval时，记录所有灯（数组）的点亮/熄灭/变色时间点，并在Timer中判断是否该熄灭/点亮/变色哪些个鸟灯。
搞不定明白为何要用Timer数组？
如果真的要人帮你，就应该按照那个歇斯底里的老马说的，把你真实的需求说出来。

Answer 9

再说个思路， 就跟ws的马子那个差不多，用一个 timer类， 你其他的对象，都将timer类的事件加入并引用到你的类中， timer 的时间设置一个合适的值，比如 1 秒， 实例化一个 timer 类， 将这个实例给所有你的对象引用，你的对象都应该知道自己是干什么的， 每隔1秒就有一次事件触发， 你的对象自己计时假设存在一个 Timer 类 想要再给吧你的类：
dim withevents TimeControl as myTimerClass－－－－ 这里全是你自己的代码，并且还有如下代码sub QuoteTimer（itimer as myTimerClass）
  对于这个timer 我倾向于都用一个timer来解决，也可以每个对象都实例化一个timer
 set TimeControl = itimer 
end subprivate  sub  TimeControl_TimerEvent()
   if 我的对象还处于活动状态 then 计时器＝计时器＋1
end sub导出一个属性， 用来表示对象的经过时间，就是将计时器 累积时间送出

Answer 10

亲，举例说明：1 你有 100 盏红绿灯。这些红绿灯是你在用代码控制。
  亲，每一盏灯在点亮的时候，你输送一条记录到一个文件，比如数据库，或者文本文件，再或者就是 Long 型的数组，记录灯的编号和点亮的时刻（例如可以用 GetTickCount 函数得到此刻主机运行的时钟数）。
  熄灯时，再取当前时刻，减去亮灯时刻，就是点亮的时间了。  亲，看看，这里不需要 Timer。2 你有 100 盏红绿灯。这些红绿灯不是你控制的，但是你可以读取到它们的状态。
  亲，你启动一个根据所需分辨率设置了间隔时间的 Timer。在每次进入计时事件的时候，亲，你就查询所有的灯。
  如果一盏灯原来是熄灭的，这一次亮了，你就将数组中相应的元素清零；
  如果一盏灯上次是亮的，现在还亮，亲，你就将对应元素加 1；
  如果一盏灯上次是亮的，现在灭了，亲，你就将对应元素加 1，然后乘以 Timer 的时间间隔。  可以有很多方法，亲，只要你肯想。