VB 中给对象计时的问题

mumumeteor 2011-10-11 11:58:15

我想给一个对象计时如红绿灯我想计算红灯亮的时间看它亮灯是否超时··· 一般我们都会有timer控件来做这件事。

但是我想计时的对象有几十个···怎么办呢？？那么多TIMER控件会严重影响到程序效率吧？

有什么有其他的办法解决类似的问题呢？

...全文

239 21 打赏收藏转发到动态举报

写回复

用AI写文章

21 条回复

切换为时间正序

请发表友善的回复…

发表回复

嗷嗷叫的老马 2011-11-04

打赏
举报

楼上的"亲体"文看得我全身发冷..................

of123 2011-11-03

打赏
举报

亲，举例说明：

1 你有 100 盏红绿灯。这些红绿灯是你在用代码控制。
亲，每一盏灯在点亮的时候，你输送一条记录到一个文件，比如数据库，或者文本文件，再或者就是 Long 型的数组，记录灯的编号和点亮的时刻（例如可以用 GetTickCount 函数得到此刻主机运行的时钟数）。
熄灯时，再取当前时刻，减去亮灯时刻，就是点亮的时间了。

亲，看看，这里不需要 Timer。

2 你有 100 盏红绿灯。这些红绿灯不是你控制的，但是你可以读取到它们的状态。
亲，你启动一个根据所需分辨率设置了间隔时间的 Timer。在每次进入计时事件的时候，亲，你就查询所有的灯。
如果一盏灯原来是熄灭的，这一次亮了，你就将数组中相应的元素清零；
如果一盏灯上次是亮的，现在还亮，亲，你就将对应元素加 1；
如果一盏灯上次是亮的，现在灭了，亲，你就将对应元素加 1，然后乘以 Timer 的时间间隔。

可以有很多方法，亲，只要你肯想。

PctGL 2011-11-02

打赏
举报

再说个思路，就跟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 sub

private sub TimeControl_TimerEvent()
if 我的对象还处于活动状态 then 计时器＝计时器＋1
end sub

导出一个属性，用来表示对象的经过时间，就是将计时器累积时间送出

tulyroll 2011-11-02

打赏
举报

难道我理解错了？

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

PctGL 2011-10-27

打赏
举报

记录活动时间，不记录经历时间
比如红灯亮了的时候记录，时间，比如早上 7 点，红灯灭了的时候记录，比如早上 8 点，就可以得出红灯亮了 1个小时，不要在这一个小时的时间里不断的记录，找到变化点

嗷嗷叫的老马 2011-10-26

打赏
举报

你得到每个对象的时间后,又要干什么?记录?还是超限了就做出某种反应?(比如报警)

感觉你像是在做什么监控程序一样.

如果是在不满足某条件后做出反应,那根据不同的反应,又有不同的手法了.

你不把整个真实需求说出来,怕是难以让人帮你.

mumumeteor 2011-10-25

打赏
举报

12#同志的意思就是用循环？？````

mumumeteor 2011-10-25

打赏
举报

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

现在还是人类 2011-10-18

打赏
举报

[Quote=引用 9 楼 mumumeteor 的回复:]
上面大哥是给很多对象定时做处理吧····

我的要求是对很多对象的状态进行计算时间····比如我吃饭花了多少时间···走路花了多少时间··睡觉花了多少时间···
要是同时监控一百个人···
我怎么处理呀？？···
[/Quote]
天哪，没救了...

嗷嗷叫的老马 2011-10-18

打赏
举报

[Quote=引用 9 楼 mumumeteor 的回复:]
上面大哥是给很多对象定时做处理吧····

我的要求是对很多对象的状态进行计算时间····比如我吃饭花了多少时间···走路花了多少时间··睡觉花了多少时间···
要是同时监控一百个人···
我怎么处理呀？？···
[/Quote]
搞半天说的这个，我汗，是你表达的问题还是我的理解问题

你要监控一百人，那就有一个输入源。

关键的问题在于输入源是什么形式。

可以一个一个去问，也可以让每个人遵守一个约定，即每做完一件事都将当前时间记录下来，然后你收集每个人的记录再去统计。

至于如何计算时间，那个反而成了简单的事了。

tulyroll 2011-10-18

打赏
举报

虽然只有20分，偶还是拼了（嘿嘿嘿....,不知道表情怎么发)

tulyroll 2011-10-18

打赏
举报

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

mumumeteor 2011-10-17

打赏
举报

上面大哥是给很多对象定时做处理吧····

我的要求是对很多对象的状态进行计算时间····比如我吃饭花了多少时间···走路花了多少时间··睡觉花了多少时间···
要是同时监控一百个人···
我怎么处理呀？？···

嗷嗷叫的老马 2011-10-15

打赏
举报

给你个基本思路，就是我上面给出的代码的思路。

每个对象设为一个人。

现在需要100个人按不同的频率握拳与摊手。

那么最好的办法是，让每个人拿着一个秒表（时间基准），再按着领到的时间决定什么时候应该握拳，什么时候应该摊手。

然后让大家的表同时开始计时，大家各自做各自的动作。

我代码你仔细看看。

定义了两个对象，里面代码很简单，大部分是属性，就是颜色与时间，坐标，以及绘图的对象。

然后只有一个方法，就是绘图。

这个方法传入的参数是一个时间基准，每个对象根据自己保存的一个“最后基准”与传入的基准进行比较，判断在某个颜色状态下经过的时间是多少，以决定是继续显示当前颜色还是切换到另一种颜色去显示。

接着就是图象的样式，方框与圆。

没了。

但绘图的方法是直接传对象，这是为了简单。。。。。效率却是很低的，所以1000个对象时每秒更新次数很低，在我机器上的FPS是33与22，前者是继承法，后者是集合法。

对于你几十个对象的要求，完全没问题，每个对象的绘制坐标，两种颜色及相应持续的时间一设定，让定时器去循环跑就是了。

mumumeteor 2011-10-15

打赏
举报

有一些笨拙···我想问的问题是关于给很多对象计时的问题···
我想大家给我的知识一个思路问题吧···
我还没领会到奥妙···能讲解下么？
如果太麻烦只能我肚子领会去了··

嗷嗷叫的老马 2011-10-13

打赏
举报

写了个使用对象思路来管理的例子.

里面有两种实现方式,一种是使用集合来存储对象,一种是使用继承,经测试,继承的性能更好,毕竟是前期绑定.

两种方式关键代码如下:

'集合方式

Option Explicit



Private Declare Function GetTickCount Lib "kernel32.dll" () As Long



Dim 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 Sub



Private Sub Command1_Click()

    Timer1.Enabled = Not Timer1.Enabled

End Sub



Private 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 Explicit



Private Declare Function GetTickCount Lib "kernel32.dll" () As Long



Dim 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 Sub



Private Sub Command1_Click()

    Timer1.Enabled = Not Timer1.Enabled

End Sub



Private 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

嗷嗷叫的老马 2011-10-13

打赏
举报

你自己也说了,多个"对象".

那就将这些"对象"真的作为一个对象来管理吧.

那样代码结构会巨简单.

我只是放个夜水,继续睡觉去........

现在还是人类 2011-10-12

打赏
举报

没事又改了改代码，这样效果看起来漂亮点，呵呵



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 Sub



Private 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

注意：窗口不要太大，不然启动的时候会慢一点

现在还是人类 2011-10-12

打赏
举报

这样改一下效果更加好：
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 Long



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

    

    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 Sub



Private 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

现在还是人类 2011-10-12

打赏
举报

一个定时器就可以了，比如你的灯是个控件数组，那么在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 Sub



Private 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