李国帅 取自日志,可能是转载的
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