'Declaraciones Api
'------------------------------

'Dibuja el texto
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" ( _
    ByVal hdc As Long, _
    ByVal lpStr As String, _
    ByVal nCount As Long, _
    lpRect As RECT, _
    ByVal wFormat As Long) As Long

' Para el intervalo de tiempo
Private Declare Function GetTickCount Lib "kernel32" () As Long

'Estructura para usar con el api DrawText
Private Type RECT
        
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long

End Type

Public Finalizar As Boolean

Public Sub Comenzar_Scroll(Objeto_Scroll As PictureBox, _
                    Texto As String, _
                    Velocidad As Long, _
                    Color_Fuente As Long)


Dim r_Height_Texto As Long
Dim ObjetoRect As RECT
Dim t_Vel As Long
Dim Ret As Long

'Propiedades para el picture o form
With Objeto_Scroll
    
    .ScaleMode = vbPixels
    .AutoRedraw = True
    'Cambiar las propiedades de la fuente
    .ForeColor = Color_Fuente
    .FontSize = 16
     
End With


Ret = DrawText(Objeto_Scroll.hdc, _
               Texto, -1, ObjetoRect, &H400)

If Ret = 0 Then MsgBox " Error ", vbCritical: Exit Sub
    
    With ObjetoRect
        
        'Posición inicial del área donde dibujar el texto
        .Top = Objeto_Scroll.ScaleHeight
        .Left = 0
        .Right = Objeto_Scroll.ScaleWidth
    
         r_Height_Texto = .Bottom
        .Bottom = .Bottom + Objeto_Scroll.ScaleHeight
    
    End With
     
'Esta variable si está en True detiene el scroll
Finalizar = False

While Finalizar = False
    
    If (GetTickCount() - t_Vel) > Velocidad Then
                            
        ' Borra el contenido
        Objeto_Scroll.Cls
        
        ' Dibuja el texto
        Call DrawText(Objeto_Scroll.hdc, _
                      Texto, -1, _
                      ObjetoRect, &H1 Or &H10)
        
        With ObjetoRect
            
            .Top = .Top - 1
            .Bottom = .Bottom - 1
            
            ' Si llegó arriba de todo comienza de nuevo el scroll _
              reseteando los valores top y bottom
            If .Top < -(r_Height_Texto) Then
                .Top = Objeto_Scroll.ScaleHeight
                .Bottom = r_Height_Texto + Objeto_Scroll.ScaleHeight
            End If
        
        End With
        
        t_Vel = GetTickCount()
        
    End If
    
    DoEvents
Wend
End Sub