Fading / Darkning

[Reece]

[code]
Option Explicit


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

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 SetLayeredWindowAttributes Lib "user32" _
(ByVal hWnd As Long, _
ByVal crKey As Byte, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) _
As Long

Private Declare Function ShowWindow Lib "user32" _
(ByVal hWnd As Long, _
ByVal nCmdShow As Long) _
As Long

Private Declare Function UpdateWindow Lib "user32" _
(ByVal hWnd As Long) _
As Boolean


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

Private Const GWL_EXSTYLE As Long = -20
Private Const LWA_ALPHA As Long = &H2
Private Const RDW_NOERASE As Long = &H20
Private Const RDW_NOFRAME As Long = &H800
Private Const RDW_INVALIDATE As Long = &H1
Private Const RDW_NOINTERNALPAINT As Long = &H10
Private Const RDW_UPDATENOW As Long = &H100
Private Const SW_SHOWNORMAL As Long = 1
Private Const WS_EX_LAYERED As Long = &H80000

'

Public Sub FadeIn(ByVal hWnd As Long, _
ByVal lngAlphaMax As Long, _
Optional ByVal lngStep As Long = 1)

Dim bAlpha As Byte
Dim lngWindowStyle As Long

bAlpha = 1

lngWindowStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
SetWindowLong hWnd, GWL_EXSTYLE, lngWindowStyle Or WS_EX_LAYERED

SetLayeredWindowAttributes hWnd, 0, bAlpha, LWA_ALPHA

' Show + refresh
ShowWindow hWnd, SW_SHOWNORMAL
UpdateWindow hWnd

Do
If (Not ((bAlpha + lngStep) > lngAlphaMax)) Then
bAlpha = bAlpha + lngStep

Else
bAlpha = lngAlphaMax

End If

SetLayeredWindowAttributes hWnd, 0, bAlpha, LWA_ALPHA
UpdateWindow hWnd

Loop Until (bAlpha >= lngAlphaMax)

' Remove the WS_EX_LAYERED flag, as it vastly
' slows down moving/resizing
SetWindowLong hWnd, GWL_EXSTYLE, lngWindowStyle

End Sub

Private Sub FadeOut(ByVal hWnd As Long, _
ByVal lngAlphaMax As Long, _
ByVal lngAlphaMin As Long, _
Optional ByVal lngStep As Long = 1, _
Optional ByVal blnUnload As Boolean = False)

Dim bAlpha As Byte
Dim lngWindowStyle As Long

' Add WS_EX_LAYERED flag
lngWindowStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
SetWindowLong hWnd, GWL_EXSTYLE, lngWindowStyle Or WS_EX_LAYERED

RedrawWindow hWnd, 0, 0, RDW_NOINTERNALPAINT + RDW_NOERASE + RDW_NOFRAME

bAlpha = CByte(lngAlphaMax)
Do
If ((bAlpha - lngStep) > lngAlphaMin) Then
bAlpha = bAlpha - lngStep

Else
bAlpha = lngAlphaMin

End If

SetLayeredWindowAttributes hWnd, 0, bAlpha, LWA_ALPHA
UpdateWindow hWnd

Loop Until (bAlpha