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. [email protected]

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           [email protected]       *
'*     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