para los k tiran visual basic
'
'------------------------------------------------------------------------------
' 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