VB如何使用计时器？

李国帅 取自日志，可能是转载的
20050912

在vb.net中

例子1

Option Strict Off
Option Explicit On
Friend Class frmAnimateLabel
    Inherits System.Windows.Forms.Form
    'and in the form............
    Private Sub frmAnimateLabel_Load()
        'Set the label position
        Lblan.Left = VB6.TwipsToPixelsX(-1360)
    End Sub


    Private Sub Command1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command1.Click

        'Start Animation
        SetTimer(Me.Handle.ToInt32, 0, 10, AddressOf AnimateLbl)

    End Sub

    Private Sub frmAnimateLabel_Unload(ByRef Cancel As Short)

        'Stop the timer and animation
        'Instead you can use another button to stop

        KillTimer(Me.Handle.ToInt32, 0)
    End Sub

End Class

Option Strict Off
Option Explicit On
Module Module1
    Public iColor As Short
    Public powerOn As Boolean
    Public activity As Boolean
    Public errors As Boolean

    'Add This Code in a module

    Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Integer, ByVal nIDEvent As Integer, ByVal uElapse As Integer, ByVal lpTimerFunc As Animate) As Integer

    Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Integer, ByVal nIDEvent As Integer) As Integer

    Public Delegate Sub Animate()
    Public Sub AnimateLbl()

        With frmAnimateLabel.DefInstance.Lblan
            .Left = VB6.TwipsToPixelsX(VB6.PixelsToTwipsX(.Left) + 30) 'Move the label by 30 units
            If VB6.PixelsToTwipsX(.Left) >= VB6.PixelsToTwipsX(frmAnimateLabel.DefInstance.Width) Then 'If the label has reached the end
                .Left = VB6.TwipsToPixelsX(-1360) 'Reset Back to the Original Position
            End If
        End With
    End Sub
End Module

例子2
在vb中

'Add This Code in a module
Option Explicit
Public iColor As Integer
Public powerOn As Boolean
Public activity As Boolean
Public errors As Boolean

Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

  Public Sub AnimateLbl()

      With frmAnimateLabel.Lblan
       .Left = .Left + 30  'Move the label by 30 units
         If .Left >= frmAnimateLabel.Width Then  'If the label has reached the end
           .Left = -1360 'Reset Back to the Original Position
             End If
             End With
   End Sub
   
Public Sub blinkLights()
   AnimateLbl
   With frmAnimateLabel
      powerOn = Not powerOn
      activity = Not activity
      errors = Not errors


      .Shape1.FillColor = IIf(powerOn, vbRed, &HC0C0C0)
      .Shape2.FillColor = IIf(activity, vbGreen, &HC0C0C0)
      .Shape3.FillColor = IIf(errors, &H80FF&, &HC0C0C0)

      iColor = iColor + 1
      Debug.Print "-------------ColorCount >>>>"; iColor
   End With
End Sub

'and in the form............
            Private Sub frmAnimateLabel_Load()
            'Set the label position
              Lblan.Left = -1360
            End Sub


            Private Sub Command1_Click()

            'Start Animation
            SetTimer Me.hwnd, 0, 100, AddressOf blinkLights
            SetTimer Me.hwnd, 0, 10, AddressOf AnimateLbl

            End Sub

            Private Sub frmAnimateLabel_Unload(Cancel As Integer)

            'Stop the timer and animation
            'Instead you can use another button to stop

            KillTimer Me.hwnd, 0
            End Sub


Private Sub Command2_Click()
            SetTimer Me.hwnd, 0, 10, AddressOf AnimateLbl

End Sub