GFLabelAnimation/GFLabelAnimationfrm.frm

VERSION 5.00
Begin VB.Form GFLabelAnimationfrm
   BorderStyle     =   0 'Kein
   Caption         =   "Form1"
   ClientHeight    =   90
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   90
   LinkTopic       =   "Form1"
   ScaleHeight     =   90
   ScaleWidth      =   90
   ShowInTaskbar   =   0 'False
   StartUpPosition =   3 'Windows‑Standard
   Begin VB.PictureBox GFLabelAnimationPicture
      Enabled         =   0 'False
      Height          =   315
      Left            =   0
      ScaleHeight     =   255
      ScaleWidth      =   135
      TabIndex        =   0
      Top             =   0
      Visible         =   0 'False
      Width           =   195
   End
End
Attribute VB_Name = "GFLabelAnimationfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001 by Louis. Allows displaying rather simple animations in any Label.
'
#Const TargetFormIsMfrmFlag = False
'
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'other
Dim AnimationPlayingFlag As Boolean

Public Sub GFLabelAnimation_SwipSwap(ByRef AnimationLabel As Label, ByVal AnimationIndex As Integer, ByVal AnimationSpeedFactor As Single, ByVal AnimationNumber As Integer, ByVal CallBackFormUsedFlag As Boolean, ByRef CallBackForm As Object)
    'on error resume next
    Dim LabelCharCountMax As Single
    Dim LabelTextPos As Single
    Dim LabelTextPosUnchanged As Single
    Dim LabelTextLength As Single
    Dim LabelTextPosMin As Single
    Dim LabelTextPosMax As Single
    Dim LabelTextMoveAmount As Single '+ or ‑
    Dim CancelAnimationFlag As Boolean
    Dim ResetLabelTextPosFlag As Boolean 'only checked if flag above became True
    'preset
    Set GFLabelAnimationPicture.Font = AnimationLabel.Font
    If AnimationLabel.Parent.ScaleMode = vbTwips Then
        LabelCharCountMax = AnimationLabel.Width / (GFLabelAnimationPicture.TextWidth(Chr$(32)) * 1)
    Else
        LabelCharCountMax = AnimationLabel.Width / (GFLabelAnimationPicture.TextWidth(Chr$(32)) * Screen.TwipsPerPixelX)
    End If
    AnimationLabel.Tag = AnimationLabel.Caption 'OVERWRITES TAG! (with unchanged caption)
    Call GetLabelTextInfo(AnimationLabel, LabelTextPos, LabelTextLength)
    LabelTextPosUnchanged = LabelTextPos
    LabelTextPosMin = 1
    LabelTextPosMax = LabelCharCountMax ‑ LabelTextLength + 1
    LabelTextMoveAmount = 1
    'begin
    AnimationPlayingFlag = True
    Do
ReDo:
        Select Case AnimationIndex
        Case 1 'just left and right
            LabelTextPos = LabelTextPos + LabelTextMoveAmount * AnimationSpeedFactor
        Case 2 'left and right, rubber‑like
            LabelTextPos = LabelTextPos + Int(LabelTextMoveAmount * (1& + (Abs((LabelCharCountMax / 2&) ‑ (LabelTextPos ‑ (LabelTextLength / 2&))) / 10&))) * AnimationSpeedFactor
        End Select
        Select Case LabelTextPos
        Case Is < LabelTextPosMin
            LabelTextMoveAmount = 1
            AnimationNumber = AnimationNumber ‑ 1
            If AnimationNumber = 0 Then Exit Do
            GoTo ReDo:
        Case Is > LabelTextPosMax
            LabelTextMoveAmount = ‑1
            GoTo ReDo:
        End Select
        Call SetLabelTextInfo(AnimationLabel, LabelTextPos, LabelTextMoveAmount, LabelTextPosMin, LabelTextPosMax)
        Call Sleep(20) 'around 50 frames
        If CallBackFormUsedFlag = True Then
            #If TargetFormIsMfrmFlag = True Then
                Call Mfrm.GFLabelAnimation_Tick(CancelAnimationFlag, ResetLabelTextPosFlag)
            #Else
                Call CallBackForm.GFLabelAnimation_Tick(CancelAnimationFlag, ResetLabelTextPosFlag)
            #End If
            If CancelAnimationFlag = True Then
                If ResetLabelTextPosFlag = True Then
                    Exit Do
                Else
                    GoTo Leave:
                End If
            End If
        End If
    Loop
    Call SetLabelTextInfo(AnimationLabel, LabelTextPosUnchanged, LabelTextMoveAmount, LabelTextPosMin, LabelTextPosMax)
Leave:
    AnimationPlayingFlag = False 'reset
End Sub

Public Function GFLabelAnimation_IsAnimationPlaying() As Boolean
    'on error resume next 'use to avoid any recursive calling of any animation function out of the callback sub
    GFLabelAnimation_IsAnimationPlaying = AnimationPlayingFlag
End Function

Private Sub GetLabelTextInfo(ByRef AnimationLabel As Label, ByRef LabelTextPos As Single, ByRef LabelTextLength As Single)
    'on error resume next
    Dim LabelText As String
    'preset
    LabelText = AnimationLabel.Tag 'a string should be accessible faster than a property
    'begin
    LabelTextLength = Len(Trim$(LabelText))
    LabelTextPos = Len(LabelText) ‑ Len(LTrim$(LabelText)) + 1
End Sub

Private Sub SetLabelTextInfo(ByRef AnimationLabel As Label, ByRef LabelTextPos As Single, ByVal LabelTextMoveAmount As Single, ByVal LabelTextPosMin As Long, ByVal LabelTextPosMax As Long)
    'on error resume next
    Dim LabelText As String
    Dim TailFor As Long
    'begin
    If LabelTextMoveAmount > 0 Then
        LabelText = String$(MAX(LabelTextPosMin, (CLng(LabelTextPos) ‑ 1&)), Chr$(32)) '‑ 1& ‑ 5 if tail used
'        For TailFor = 1 To MIN(MAX(LabelTextPosMin, (CLng(LabelTextPos) ‑ 1& ‑ 5)), 5)
'            If TailFor = 1 Then
'                LabelText = LabelText + " "
'            Else
'                If (Rnd(1) < 0.5) Then
'                    LabelText = LabelText + "o"
'                Else
'                    LabelText = LabelText + "." 'Chr$(Int(110 ‑ 65 + 1) * Rnd(1) + 65)
'                End If
'            End If
'        Next TailFor
        LabelText = LabelText + LTrim$(AnimationLabel.Tag)
        AnimationLabel.Caption = LabelText
    Else
        LabelText = String$(CLng(LabelTextPos) ‑ 1&, Chr$(32)) + LTrim$(AnimationLabel.Tag)
'        For TailFor = 1 To MIN(5, LabelTextPosMax ‑ LabelTextPos)
'            If TailFor = 1 Then
'                LabelText = LabelText + " "
'            Else
'                If (Rnd(1) < 0.5) Then
'                    LabelText = LabelText + "o"
'                Else
'                    LabelText = LabelText + "." 'Chr$(Int(110 ‑ 65 + 1) * Rnd(1) + 65)
'                End If
'            End If
'        Next TailFor
        AnimationLabel.Caption = LabelText
    End If
    AnimationLabel.Refresh
End Sub

Private Function MAX(ByVal v1 As Long, ByVal v2 As Long) As Long
    'on error resume next
    If v1 > v2 Then
        MAX = v1
    Else
        MAX = v2
    End If
End Function

Private Function MIN(ByVal v1 As Long, ByVal v2 As Long) As Long
    'on error resume next
    If v1 < v2 Then
        MIN = v1
    Else
        MIN = v2
    End If
End Function


[END OF FILE]