Mirage Source

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 <= lngAlphaMin)
   
    'If (blnUnload) Then PostMessage hWnd, WM_CLOSE, 0, ByVal 0&
End Sub


Private Sub Form_Load()
    FadeIn Me.hWnd, 255, 1
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    FadeOut Me.hWnd, 255, 0, 1, False
End Sub