Public Declare Function GetWindowLong Lib "user32" Alias _
    "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex 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 SetLayeredWindowAttributes Lib "user32" _
    (ByVal hWnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, _
     ByVal dwFlags As Long) As Long

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Const WS_EX_TRANSPARENT = &H20&
Public Const LWA_ALPHA = &H2&

Public Enum FadeDirection
    FadeIn = -1
    FadeOut = 0
    SetOpacity = 1
End Enum

Public Sub FadeForm(frm As Form, _
        Optional Direction As FadeDirection = FadeDirection.FadeIn, _
        Optional iDelay As Integer = 0, _
        Optional StartOpacity As Long = 5)
    
    Dim lOriginalStyle As Long
    Dim iCtr As Integer

    'Remember the original form (window) style
    lOriginalStyle = GetWindowLong(frm.hWnd, GWL_EXSTYLE)
    SetWindowLong frm.hWnd, GWL_EXSTYLE, lOriginalStyle Or WS_EX_LAYERED
    
    If (lOriginalStyle = 0) And (Direction <> FadeDirection.SetOpacity) Then
        FadeForm frm, SetOpacity, , StartOpacity
    End If
    
    Select Case Direction
        Case FadeDirection.FadeIn
            If StartOpacity < 1 Then StartOpacity = 1
            
            For iCtr = StartOpacity To 255 Step 20
                SetLayeredWindowAttributes frm.hWnd, 0, CByte(iCtr), LWA_ALPHA
                DoEvents
                Sleep iDelay
            Next
        Case FadeDirection.FadeOut
            If StartOpacity < 6 Then StartOpacity = 255
            
            For iCtr = StartOpacity To 1 Step -20
                SetLayeredWindowAttributes frm.hWnd, 0, CByte(iCtr), LWA_ALPHA
                DoEvents
                Sleep iDelay
            Next
        Case Else 'FadeDirection.SetOpacity
            Select Case StartOpacity
                Case Is < 1: StartOpacity = 1
                Case Is > 255: StartOpacity = 255
            End Select
                            
            SetLayeredWindowAttributes frm.hWnd, 0, CByte(StartOpacity), LWA_ALPHA
            DoEvents
    End Select
End Sub