Sección de códigos , trucos y ejemplos para visual basic

347 - Efecto Fade simple

Sencillo efecto de fade para cambiar de color el fondo de un formulario o picturebox, y también en un texto

Este simple ejemplo tiene dos funciones . Una llamada EfectoFadeFondo que cambia el color o BackColor en un objeto form o picture, tomando dos colores ( Color Inicial y color final )

La otra función EfectoFadeTexto, es similar a la anterior, pero para aplicarla a un texto que se dibuja con el método Print en un picture o form. También se le debe indicar como parámetro el color inicial y el color final del mismo

Controles

Agregar un control Command button en el formulario
y también un módulo bas al proyecto

Código fuente en el formulario

Option Explicit Sub Efecto() ' 1 '''''''''' Call Efecto_Fade_Fondo(Me, vbBlack, vbWhite) Call Efecto_Fade_Texto(Me, vbWhite, vbBlack, "Hola Mundo !!!", "Verdana", 20) Call Efecto_Fade_Texto(Me, vbBlack, vbWhite, "Hola Mundo !!!", "Verdana", 20) '2 ''''''''''' Call Efecto_Fade_Fondo(Me, vbWhite, vbBlack) Call Efecto_Fade_Texto(Me, vbBlack, vbGreen, "Hola Mundo !!!", "Verdana", 16, 0, 1500) Call Efecto_Fade_Texto(Me, vbGreen, vbBlack, "Hola Mundo !!!", "Verdana", 16, 0, 1500) '3 '''''''''' Call Efecto_Fade_Fondo(Me, vbBlack, &HFFC0C0) Call Efecto_Fade_Texto(Me, &HFFC0C0, vbBlack, "Hola Mundo !!!", "Arial", 18, 1000, 1000) Call Efecto_Fade_Texto(Me, vbBlack, vbWhite, "Hola Mundo !!!", "Arial", 18, 1000, 1000) Call Efecto_Fade_Texto(Me, vbWhite, &HFFC0C0, "Hola Mundo !!!", "Arial", 18, 1000, 1000) End Sub Private Sub Command1_Click() Command1.Enabled = False Call Efecto Command1.Enabled = True End Sub Private Sub Form_Load() Me.AutoRedraw = True Me.FontSize = 20 Me.FontName = "Verdana" Me.BackColor = vbBlack End Sub Private Sub Form_Unload(Cancel As Integer) Unload Me End End Sub

Código fuente en el módulo bas

Option Explicit ' Api para generar una pausa Private Declare Function GetTickCount& Lib "kernel32" () ' Type para guardar los colores iniciales y finales en RGB Private Type T_Color Rojo_Inicial As Byte Verde_Inicial As Byte Azul_Inicial As Byte Rojo_Final As Byte Verde_Final As Byte Azul_Final As Byte End Type ' Aplica el efecto fade al color de fondo del Picturebox o formulario ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Sub Efecto_Fade_Fondo( _ ByVal obj As Object, _ ByRef Color_Inicial As Long, _ ByRef Color_Final As Long) Dim i As Long Dim Color As T_Color With Color Obtener_RGB Color_Inicial, .Rojo_Inicial, .Verde_Inicial, .Azul_Inicial Obtener_RGB Color_Final, .Rojo_Final, .Verde_Final, .Azul_Final i = 0 Do While i < 255 obj.BackColor = RGB(.Rojo_Inicial, .Verde_Inicial, .Azul_Inicial) If .Rojo_Inicial < .Rojo_Final Then .Rojo_Inicial = .Rojo_Inicial + 1 ElseIf .Rojo_Inicial > .Rojo_Final Then .Rojo_Inicial = .Rojo_Inicial - 1 End If If .Verde_Inicial < .Verde_Final Then .Verde_Inicial = .Verde_Inicial + 1 ElseIf .Verde_Inicial > .Verde_Final Then .Verde_Inicial = .Verde_Inicial - 1 End If If .Azul_Inicial < .Azul_Final Then .Azul_Inicial = .Azul_Inicial + 1 ElseIf .Azul_Inicial > .Azul_Final Then .Azul_Inicial = .Azul_Inicial - 1 End If Pausar 1 i = i + 1 DoEvents Loop End With End Sub ' Sub que Aplica el efecto fade al texto en el Picturebox o formulario indicado ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Sub Efecto_Fade_Texto( _ ByVal obj As Object, _ Color_Inicial As Long, _ Color_Final As Long, _ texto As String, _ Fuente As String, _ SizeFont As Integer, _ Optional PosX As Single = 0, _ Optional posY As Single = 0) Dim i As Long Dim Color As T_Color With Color ' convierte los valores a RGB Obtener_RGB Color_Inicial, .Rojo_Inicial, .Verde_Inicial, .Azul_Inicial Obtener_RGB Color_Final, .Rojo_Final, .Verde_Final, .Azul_Final i = 0 obj.FontName = Fuente obj.FontSize = SizeFont Do While i < 255 obj.ForeColor = RGB(.Rojo_Inicial, .Verde_Inicial, .Azul_Inicial) ' imprime el texto obj.Cls obj.CurrentX = PosX obj.CurrentY = posY obj.Print texto ' cambia los colores If .Rojo_Inicial < .Rojo_Final Then .Rojo_Inicial = .Rojo_Inicial + 1 ElseIf .Rojo_Inicial > .Rojo_Final Then .Rojo_Inicial = .Rojo_Inicial - 1 End If If .Verde_Inicial < .Verde_Final Then .Verde_Inicial = .Verde_Inicial + 1 ElseIf .Verde_Inicial > .Verde_Final Then .Verde_Inicial = .Verde_Inicial - 1 End If If .Azul_Inicial < .Azul_Final Then .Azul_Inicial = .Azul_Inicial + 1 ElseIf .Azul_Inicial > .Azul_Final Then .Azul_Inicial = .Azul_Inicial - 1 End If Pausar 1 i = i + 1 DoEvents Loop End With End Sub ' genera una espera Sub Pausar(Milisegundos As Long) Dim t As Long t = GetTickCount + Milisegundos While GetTickCount < t DoEvents Wend End Sub ' convierte el valor de color Long a su valor RGB '''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub Obtener_RGB(ByVal Color As Long, _ Rojo As Byte, _ Verde As Byte, _ Azul As Byte) Azul = (Color And 16711680) / 65536 Verde = (Color And 65280) / 256 Rojo = Color And 255 End Sub

Recursos vb 6.0 - Relacionados

Animación de ventanas y controles con el Api AnimateWindow

Recursos vb.NET - Relacionados

control y módulo para aplicar transparencia a un Windows Forms

Buscar en Recursos vb