CaptionEffect




Option Explicit
Private jCaption() As String
Private jUbound As Integer
Private jOriginal As String
Private Sub Form_Load()
CaptionGrabber Label1
End Sub

Private Sub Timer1_Timer()
CaptionEffects Label1
End Sub

Public Sub CaptionGrabber(jObject As Object)
Dim intX As Integer
jOriginal = jObject.Caption
jUbound = Len(jOriginal)
ReDim jCaption(1 To jUbound)
For intX = 1 To jUbound
jCaption(intX) = Left(jOriginal, 1)
jOriginal = Right(jOriginal, Len(jOriginal) - 1)
Next
jOriginal = jObject.Caption
jObject.Caption = ""
End Sub

Public Sub CaptionEffects(jObject As Object)
Static jCounter As Integer
Dim intX As Integer
Dim tmpCaption As String
Static A_B As Boolean
Dim Words() As String
If jCounter >= jUbound Then
jCounter = 0
If jObject.Tag <> "Scroll" Then
jObject.Caption = ""
End If
A_B = Not A_B
End If
jCounter = jCounter + 1
Select Case LCase(jObject.Tag)
Case "type"
jObject.Caption = jObject.Caption & jCaption(jCounter)
Case "chew"
jObject.Caption = Left(jOriginal, (jUbound - jCounter + 1))
Case "melt"
For intX = jCounter To jUbound
tmpCaption = tmpCaption & jCaption(intX)
jObject.Caption = tmpCaption
Next
Case "scroll"
If A_B = False Then
jObject.Caption = Space$((jUbound - jCounter + 1)) & Left(jOriginal, jCounter)
Else
jObject.Caption = Right(jObject.Caption, (jUbound - jCounter + 1))
End If
Case "words"
Words() = Split(jOriginal)
jObject.Caption = Words(jCounter - 1)
If jCounter - 1 = UBound(Words()) Then
jCounter = 0
End If
Case Else
jObject.Caption = jOriginal
End Select
End Sub

Inserite una caption alla proprieta del vostro oggetto
a cui volete applicare l'effetto
Assign il nome dell'effetto (da uno statement select case )
attraverso la proprieta tag del vostro controllo.
Utilizzate un controllo Timer
Settate l'intervallo per l'effetto suggerisco fra 200 e 600.










( captioneffect.html )- by Paolo Puglisi - Modifica del 17/12/2023