Formularios Transparentes
Un módulo para hacer un formulario
transparente (u opaco) en Windows 2000

Fecha: 22/Dic/2002 (12/09/2002)
Autor: Pedro R.M. henguld@hotmail.com

Bueno, ante todo, gracias Guille por la página y por el curso de VB que seguí ya hace casi un año, y desde entonces alguna que otra trastada mas que he ido mirando en tu web, que desde luego ayuda de vez en cuando.

Con este módulo la idea es poder utilizar la funcionalidad de Windows 2000 (y creo que XP) de hacer formularios que aparecen y desaparecen lentamente en nuestra aplicación. Hay controles para eso, pero como ya se viene viendo desde hace bastante tiempo, en Windows 2000 los chicos de Microsoft se esmeraron en esos detalles, y nos pusieron el uso de la propiedad WS_EX_LAYERED para hacer ventanas que aparecen lentamente, como todos sus menús y tal.

En muchas páginas de Internet, he visto esa funcionalidad incorporada directamente a programas ejemplo, todos hacían lo mismo, pero ninguno daba una solución (que se pudiera convertir en un módulo) al problemilla que ocurre cuando trasteas un formulario por primera vez, el problema que me tuvo con un soberano dolor de cabeza mientras hacía este módulo... cuando haces el efecto que sea, la primera vez el formulario aparece totalmente negro. Pues bueno, resuelto ha quedado. Probablemente no sea la mejor manera, ni la mas elegante, pero funciona.

Este es el código del módulo. Su distribución es totalmente libre y para lo que querais.

'****************************************************************
'*                                                              *
'*                    FadeModulo.bas                            *
'*                                                              *
'*     Modulo para hacer aparecer y desaparecer                 *
'*     formularios en windows 2000 de manera gradual.           *
'*     mediante el uso de la API de windows 2000                *
'*                                                              *
'*                                                              *
'*     (c) Pedro R. M. 2002           henguld@hotmail.com       *
'*     De Distribución libre y abierta para cualquier uso       *
'*                                                              *
'****************************************************************
Option Explicit

' Constantes necesarias para las funciones de la API

Public Const WS_EX_LAYERED As Long = &H80000
Public Const LWA_ALPHA As Long = &H2
Public Const GWL_EXSTYLE = (-20)

' Las Funciones de la API...

Public Declare Function SetLayeredWindowAttributes Lib "user32" _
    (ByVal hWnd As Long, ByVal crKey As Long, _
    ByVal bAlpha As Long, ByVal dwFlags As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    



Public Sub do_fadein(frmVentana As Form, nIncremento As Integer)
Dim nValor As Integer

' Esta Función nos permite hacer aparecer desde 0 una ventana.
' nValor es el punto de inicio del fundido. Si lo ajustamos a 0 será desde 0
' de lo contrario... pues.. eso, podemos iniciar en un punto que no sea 0

' nIncremento es el ritmo con el que aparecerá. Si quereis hacerlo con relativa rapidez, poned un valor alto.
' Con 5 va bastante rápido. 10 es "casi" el mismo valor que usa Windows.


If nIncremento < 0 Or nIncremento > 100 Then Exit Sub

' Si la ventana no es layered... pues la hacemos layered

Call SetWindowLong(frmVentana.hWnd, GWL_EXSTYLE, GetWindowLong(frmVentana.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)

nValor = 0
While nValor < 101
Call SetLayeredWindowAttributes(frmVentana.hWnd, 0, (255 * nValor) / 100, LWA_ALPHA)
nValor = nValor + nIncremento
frmVentana.Refresh                       ' Este Refresh evita que se nos ponga el formulario en negro la primera vez
                                         ' que hacemos el fundido.
                                         ' Sinceramente, no se por qué lo hace, solo se que así no lo hace :-)
DoEvents
Wend

Call SetLayeredWindowAttributes(frmVentana.hWnd, 0, (255 * 100) / 100, LWA_ALPHA)
frmVentana.Refresh

End Sub

Public Sub do_fadeout(frmVentana As Form, nDecremento As Integer)
Dim nValor As Integer

' Esta Función nos permite hacer desaparecer hasta 0 una ventana.
' nValor es el punto de comienzo del fundido. Si lo ajustamos a 100 será desde visibilidad total
' de lo contrario... pues.. eso, podemos iniciar en un punto que no sea 100

' nDecremento es el ritmo con el que desaparecerá. Si queréis hacerlo con relativa rapidez, poned un valor alto.
' Con 5 va bastante rápido. 10 es el mismo efecto que causa Windows.

If nDecremento < 0 Or nDecremento > 100 Then Exit Sub

' Si la ventana no es layered... pues la hacemos layered

Call SetWindowLong(frmVentana.hWnd, GWL_EXSTYLE, GetWindowLong(frmVentana.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)


nValor = 100
While nValor > -1
Call SetLayeredWindowAttributes(frmVentana.hWnd, 0, (255 * nValor) / 100, LWA_ALPHA)
nValor = nValor - nDecremento
frmVentana.Refresh
DoEvents
Wend

Call SetLayeredWindowAttributes(frmVentana.hWnd, 0, (255 * 0) / 100, LWA_ALPHA)
frmVentana.Refresh
End Sub


Public Sub do_fade(frmVentana As Form, nPorCiento As Integer)


If nPorCiento < 0 Or nPorCiento > 100 Then Exit Sub

' Esta funcion es simplemente para hacer una ventana un % visible en pantalla

Call SetWindowLong(frmVentana.hWnd, GWL_EXSTYLE, GetWindowLong(frmVentana.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)

Call SetLayeredWindowAttributes(frmVentana.hWnd, 0, (255 * nPorCiento) / 100, LWA_ALPHA)
frmVentana.Refresh



End Sub