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
