Cómo conseguir el efecto "marquesina desplazándose" en el control de un formulario


Volver
'**********************************************************
' Este sería un método para simular el efecto "marquesina
' desplazándose" que aparece en las páginas web pero en un
' control de un formulario.
'
' Para el ejemplo que emplearemos aquí, en un formulario 
' creamos una etiqueta llamada "lblMarquesina" y con la 
' longitud que mejor nos parezca, y que albergará el texto
' desplazándose. 
'
' En la propiedad "Intervalo de cronometro" del formulario 
' ponemos 100.
'
' Creamos una variable global para el formulario
'
Dim Blancos As Integer
'
' Después asociamos este código al evento Load del
' formulario (utilizaremos aquí el método 
' TwipsFromFont del objeto WizHook
' 
Private Sub Form_Load()
Dim wzFontName As String
Dim wzSize As Long
Dim wzWeight As Long
Dim wzItalic As Boolean
Dim wzUnderline As Boolean
Dim wzCch As Long
Dim wzCaption As String
Dim wzMaxWidthCch As Long
Dim wzdx As Long
Dim wzdy As Long

    WizHook.Key = 51488399
    
    wzFontName = Me.lblMarquesina.FontName
    wzSize = Me.lblMarquesina.FontSize
    wzWeight = Me.lblMarquesina.FontWeight
    wzItalic = Me.lblMarquesina.FontItalic
    wzUnderline = Me.lblMarquesina.FontUnderline
    wzCaption = " "
        
    ' calculamos cuantos twips tiene un blanco
    WizHook.TwipsFromFont wzFontName, wzSize, wzWeight, _
                          wzItalic, wzUnderline, wzCch, _
                          wzCaption, wzMaxWidthCch, _
                          wzdx, wzdy

   'calculamos a cuantos blancos corresponde la longitud
   'total del control que contendrá la marquesina
   Blancos = Me.lblMarquesina.Width / wzdx
   fraseTMP = ""

End Sub
'
' Después escribimos asociamos este otro código al avento
' Timer del formulario
'
Private Sub Form_Timer()
Dim cadena As String
   
   ' se asigna una cadena de texto para que aparezca
   ' en la marquesina
   cadena = "Método para simular el efecto marquesina "
   cadena = cadena & "desplazándose en el control de "
   cadena = cadena & "un formulario. Juan M. Afán Ribera"

   ' la cadena será igual a la cantidad proporcional de
   ' blancos, que es la longitud del control, más la 
   ' cadena de texto. De esta manera se construye el 
   ' efecto de que la cadena de texto "aparezca por la
   ' derecha del control
   cadena = String(Blancos, " ") & cadena
   Me.lblMarquesina.Caption = Marquesina(cadena)
   
End Sub
'************** Fin código formulario *********************
' 
' Luego, en un módulo estandar deberíamos declarar una
' variable pública
'
Public fraseTMP As String
'  
' seguida de esta función, que lo que hace es ir 
' decrementando la frase pasada como parametro en un 
' caracter cada vez. Cuando la variable fraseTMP ya no
' contenga ningún carácter (sea igual a ""), se vuelve
' a empezar desde el principio.
' 
' El efecto conseguido sería algo así:
'
'                           "        "
'                           "       T"
'                           "      Te"
'                           "     Tex"
'                           "    Text"
'                           "   Texto"
'                           "  Texto "
'                           " Texto  "
'                           "Texto   "
'                           "exto    "
'                           "xto     "
'                           "to      "
'                           "o       "
'                           "        "
' 
' ... y vuelta a empezar
'
' Juan M. Afán de Ribera
' Creado: Marzo 2003
' 1a revisión: Septiembre 2003
'
Function Marquesina(frase As String) As String

   If fraseTMP = "" Then
      fraseTMP = frase
   Else
      fraseTMP = Right(fraseTMP, Len(fraseTMP) - 1)
   End If
   
   Marquesina = fraseTMP
   
End Function
'**************** Fin código módulo ***********************
Contactar Última actualización 21/09/2003     © Juan M. Afán deRibera