Layered Windows desde Visual Basic

(o cómo hacer ventanas transparentes en Windows 2000/XP)





Publicado: 04/May/2000

Si has tenido la oportunidad de "ver" el Windows 2000, (en cualquiera de sus versiones), seguramente habrás notado la transición que hacen los menús al mostrarse e incluso el cursor con sombreado transparente... Todo esto es posible gracias a que Windows 2000 tiene "funciones" para hacer formularios transparentes...

 

Sí, ya sé que lo de hacer formularios transparente en Visual Basic es fácil..., (al menos después de que nuestro colega Luis Sanz nos proporcionara un control para hacer los formularios transparentes, si no sabes de que estoy hablando, sigue este link.); pero de lo que estamos hablando es de una transparencia "total", además manejada por el propio sistema operativo, en este caso sólo en el Windows 2000, (no se si la nueva versión del Windows 98 (Millenium) lo tendrá... así que, hasta que no salga, habrá que esperar...)

La cuestión es que leyendo, hace unos días, un artículo aparecido en el MSDN news del pasado Enero/Febrero 2000, me "calenté" con el tema este... la cuestión, según la planteaban, era fácil, simplemente había que cambiar un "bit" del estilo de la ventana para que fuese WM_EX_LAYERED, llamar a una función del API para hacer que fuese transparente y ya está.
El código mostrado era este:

'
// Set WS_EX_LAYERED on this window
SetWindowLong(hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) | WS_EX_LAYERED);
        
// Make this window 70% alpha
SetLayeredWindowAttributes(hWnd, 0, (255 * 70) / 100, LWA_ALPHA);


El primer problema con el que me topé era que no encontré el valor de la constante WS_EX_LAYERED; pero, para algo están los grupos de noticias, así que hice lo que muchos tendríais que hacer antes de enviarme consultas... (je, je), es decir, pregunté por el valor de esa constante en un grupo de noticias y al día siguiente ya tenía la respuesta... (Mi agradecimiento a Bill McCarthy y a Tomas Restrepo por facilitarme el valor de esa constante y a Tomás por indicarme dónde encontrar la definición de la misma)
En el fichero de cabecera WinUser.h en el que estaba el valor de esa constante, así como la de LWA_ALPHA, encontré también la definición (en C) de la función SetLayeredWindowAttributes, lo que quedaba era convertirla al Visual Basic y probarla...

Aquí tienes las declaraciones en formato Visual Basic de las constantes y la susodicha función:

'
Private Const WS_EX_LAYERED As Long = &H80000
Private Const LWA_ALPHA As Long = &H2
'
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
    (ByVal hWnd As Long, ByVal crKey As Long, _
    ByVal bAlpha As Long, ByVal dwFlags As Long) As Long

Lo siguiente era probarla... por supuesto, como he dicho antes, en Windows 2000, ya que en Windows 98 no existe esa función en el fichero user32.
Esto es lo que hay que hacer para que se convierta en un formulario transparente: (después veremos el código completo)


'// Set WS_EX_LAYERED on this window
Call SetWindowLong(hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)

'// Make this window 70% alpha
Call SetLayeredWindowAttributes(hWnd, 0, (255 * 70) / 100, LWA_ALPHA)

Fíjate en el tercer parámetro, el que le indica a la función que porcentaje de transparencia queremos, los valores que puede tomar van desde 0 a 255.

En el programilla de ejemplo, además de poder hacer transparente un formulario, pudiendo seleccionar la cantidad de "transparencia" del mismo, he añadido hacer un efecto "fade", es decir que el formulario aparezca desde transparente hasta normal.

 

Veamos una "foto" del formulario transparente en ejecución y después veremos el código, con todas las declaraciones de las funciones del API usadas en el mismo.



El formulario transparente en funcionamiento.

'
'------------------------------------------------------------------------------
' Prueba de WS_EX_LAYERED                                           (24/Abr/00)
' Sólo para Windows 2000
'
' ©Guillermo 'guille' Som, 2000
'
' Parte del código está basado en un ejemplo de C++ publicado en:
' MSDN news January/February 2000 Volume 9, Number 1
' Autores: Vadim Gorokhovsky y Lou Amadio
'
' Agradecimientos a Bill McCarthy y Tomas Restrepo por facilitarme el valor
' de WS_EX_LAYERED
'------------------------------------------------------------------------------
Option Explicit

Private mAlpha As Long

' Declaraciones para Layered Windows (sólo Windows 2000 y superior)
Private Const WS_EX_LAYERED As Long = &H80000
Private Const LWA_ALPHA As Long = &H2
'
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
    (ByVal hWnd As Long, ByVal crKey As Long, _
    ByVal bAlpha As Long, ByVal dwFlags As Long) As Long

'------------------------------------------------------------------------------
Private Const GWL_EXSTYLE = (-20)

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

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


Private Const RDW_INVALIDATE = &H1
Private Const RDW_ERASE = &H4
Private Const RDW_ALLCHILDREN = &H80
Private Const RDW_FRAME = &H400

Private Declare Function RedrawWindow2 Lib "user32" Alias "RedrawWindow" _
    (ByVal hWnd As Long, ByVal lprcUpdate As Long, ByVal hrgnUpdate As Long, _
    ByVal fuRedraw As Long) As Long


Private Sub cmdFade_Click()
    ' Hacer efecto Fade
    '
    If cmdFade.Caption = "Hacer &Fade" Then
        cmdFade.Caption = "Quitar &Fade"
        
        ' Guardar el valor actual del TextBox
        With txtAlpha
            .Tag = .Text
        End With
        
        ' Para que no se ponga negra antes de empezar el fade,
        ' seguramente es una chapuza, pero ¡funciona!
        Hide
        txtAlpha = "1"
        cmdLayered_Click 0
        Show
        
        '// Set WS_EX_LAYERED on this window
        Call SetWindowLong(hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
        
        ' Empezar el efecto desde 20% de transparencia
        Const cAlpha As Long = 20
        
        mAlpha = cAlpha
        
        Timer1.Interval = txtInterval
        Timer1.Enabled = True
    Else
        cmdFade.Caption = "Hacer &Fade"
        Timer1.Enabled = False
        ' Quitar el efecto Layered
        cmdLayered_Click 1
        ' Volver a dejar el valor que había
        With txtAlpha
            .Text = .Tag
        End With
    End If
    
End Sub


Private Sub cmdLayered_Click(Index As Integer)
    
    If Index = 0 Then                   ' Aplicar el efecto
        Dim tAlpha As Long
        
        tAlpha = Val(txtAlpha)
        If tAlpha < 1 Or tAlpha > 100 Then
            tAlpha = 70
        End If
        
        '// Set WS_EX_LAYERED on this window
        Call SetWindowLong(hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
        
        '// Make this window tAlpha% alpha
        Call SetLayeredWindowAttributes(hWnd, 0, (255 * tAlpha) / 100, LWA_ALPHA)
    
    Else                                ' Quitar el efecto
        '// Remove WS_EX_LAYERED from this window styles
        Call SetWindowLong(hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) And Not WS_EX_LAYERED)
        
        '// Ask the window and its children to repaint
        Call RedrawWindow2(hWnd, 0&, 0&, RDW_ERASE Or RDW_INVALIDATE Or RDW_FRAME Or RDW_ALLCHILDREN)
    End If
End Sub


Private Sub cmdSalir_Click()
    Unload Me
End Sub


Private Sub Form_Load()
    ' Deshabilitar el temporizador
    Timer1.Enabled = False
    
    ' Aplicar el efecto
    cmdLayered_Click 0
End Sub


Private Sub Timer1_Timer()
    ' Mostrar el valor...
    txtAlpha = mAlpha
    
    '// Make this window tAlpha% alpha
    Call SetLayeredWindowAttributes(hWnd, 0, (255 * mAlpha) / 100, LWA_ALPHA)
    
    mAlpha = mAlpha + 10
    If mAlpha > 100 Then
        Timer1.Enabled = False
        cmdLayered_Click 1
        cmdFade.Caption = "Hacer &Fade"
        ' Volver a dejar el valor que había
        With txtAlpha
            .Text = .Tag
        End With
    End If
End Sub

Bueno, esto es todo... espero que pueda serte de utilidad.

Nos vemos.
Guillermo


ir al índice