VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cDemonWindow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'I wrote this class to simplify the use of the AnimateWindow and Transparency features
'in Win2k. It has a function for all the combinations possible

'*****************Constants********************
Private Const AW_DURATION_DEFAULT = 200 'duration of animation

Private Const AW_HOR_POSITIVE = &H1 'left to right animation
Private Const AW_HOR_NEGATIVE = &H2 'right to left animation
Private Const AW_VER_POSITIVE = &H4 'top to bottom animation
Private Const AW_VER_NEGATIVE = &H8 'bottom to top animation
Private Const AW_CENTER = &H10 'collapses the wnd inward when used with AW_HIDE, or outward otherwise
Private Const AW_SLIDE = &H40000 'cannot use with aw_center, slide animation
Private Const AW_BLEND = &H80000 'fade wnd(only top wnd)
Private Const AW_HIDE = &H10000    'hide the wnd
Private Const AW_ACTIVATE = &H20000 'activate the wnd

Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1&
Private Const LWA_ALPHA = &H2&

Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
'*************************************************

'****************Declares***********************
Private Declare Function AnimateWindow Lib "user32" ( _
                                                ByVal hWnd As Long, ByVal dwTime As Long, _
                                                ByVal dwFlags As Long) As Boolean
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 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 GetParent Lib "user32" _
                                                (ByVal hWnd As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" _
                                                (ByVal hWnd As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
                                                (lpVersionInformation As OSVERSIONINFO) As Long
'*************************************************

'****************Types**************************
Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128      '  Maintenance string for PSS usage
End Type
'************************************************

'***************Variables**********************
'
'************************************************

'Because these functions and properties only work on win2k, we need a check
Private Function IsWin2k() As Boolean
Dim os As OSVERSIONINFO

    IsWin2k = False
        With os
            .dwOSVersionInfoSize = Len(os)
            Call GetVersionEx(os)
                If .dwPlatformId = VER_PLATFORM_WIN32_NT Then
                    IsWin2k = (.dwMajorVersion > 4)
                End If
        End With
End Function

'The next functions can be used to create any transitions effect, or set transparency for a
'form.

Public Function LoadLeftToRight(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function

        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_HOR_POSITIVE Or AW_ACTIVATE)
    End If
End Function
Public Function EndLeftToRight(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function
                
        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_HOR_POSITIVE Or AW_HIDE)
    End If
End Function

Public Function LoadRightToLeft(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function
        
        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_HOR_NEGATIVE Or AW_ACTIVATE)
    End If
End Function
Public Function EndRightToLeft(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function
        
        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_HOR_NEGATIVE Or AW_HIDE)
    End If
End Function

Public Function LoadTopToBottom(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function
        
        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_VER_POSITIVE Or AW_ACTIVATE)
    End If
End Function
Public Function EndTopToBottom(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function
            
        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_VER_POSITIVE Or AW_HIDE)
    End If
End Function

Public Function LoadBottomToTop(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function

        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_VER_NEGATIVE Or AW_ACTIVATE)
    End If
End Function
Public Function EndBottomToTop(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function

        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_VER_NEGATIVE Or AW_HIDE)
    End If
End Function

Public Function LoadCenter(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function

        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_CENTER Or AW_ACTIVATE)
    End If
End Function
Public Function EndCenter(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function

        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_CENTER Or AW_HIDE)
    End If
End Function

Public Function LoadDiagonalTopLeft(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function

        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_VER_POSITIVE Or AW_HOR_POSITIVE Or AW_ACTIVATE)
    End If
End Function
Public Function EndDiagonalTopLeft(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function

        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_VER_POSITIVE Or AW_HOR_POSITIVE Or AW_HIDE)
    End If
End Function

Public Function LoadDiagonalBottomLeft(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function

        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_VER_NEGATIVE Or AW_HOR_POSITIVE Or AW_ACTIVATE)
    End If
End Function
Public Function EndDiagonalBottomLeft(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function

        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_VER_NEGATIVE Or AW_HOR_POSITIVE Or AW_HIDE)
    End If
End Function

Public Function LoadDiagonalTopRight(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function

        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_VER_POSITIVE Or AW_HOR_NEGATIVE Or AW_ACTIVATE)
    End If
End Function
Public Function EndDiagonalTopRight(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function

        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_VER_POSITIVE Or AW_HOR_NEGATIVE Or AW_HIDE)
    End If
End Function

Public Function LoadDiagonalBottomRight(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function

        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_VER_NEGATIVE Or AW_HOR_NEGATIVE Or AW_ACTIVATE)
    End If
End Function
Public Function EndDiagonalBottomRight(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function

        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_SLIDE Or AW_VER_NEGATIVE Or AW_HOR_NEGATIVE Or AW_HIDE)
    End If
End Function

'my favorite
Public Function FadeIn(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function
        
        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_BLEND Or AW_ACTIVATE)
    End If
End Function
Public Function FadeOut(ByVal hWnd As Long, Optional ByVal iDuration As Integer)
    If IsWin2k Then
        If hWnd = 0 Then Exit Function
        
        If iDuration < 0 Or iDuration = 0 Or iDuration > 600 Then
            iDuration = AW_DURATION_DEFAULT
        End If
        'finally, execute the animation
        Call AnimateWindow(hWnd, iDuration, AW_BLEND Or AW_HIDE)
    End If
End Function

'**********functions for error free window layering***************
'transparency only works for the top window, so we have to look for it
Private Function GetTopWnd(ByVal hChild As Long)
Dim hWnd As Long
    hWnd = hChild
        Do While IsWindowVisible(GetParent(hWnd))
            hWnd = GetParent(hChild)
            hChild = hWnd
        Loop
    GetTopWnd = hWnd
End Function

Public Function AttachTransparency(ByVal hWnd As Long, _
                                                ByVal alpha As Byte) As Boolean
Dim nStyle As Long
    If IsWin2k Then
        hWnd = GetTopWnd(hWnd)
        nStyle = GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
            If SetWindowLong(hWnd, GWL_EXSTYLE, nStyle) Then
                AttachTransparency = CBool(SetLayeredWindowAttributes(hWnd, 0, CLng(alpha), LWA_ALPHA))
            End If
    End If
End Function

Public Function DetachTransparency(ByVal hWnd As Long)
Dim nStyle As Long
    If IsWin2k Then
        hWnd = GetTopWnd(hWnd)
        Call SetLayeredWindowAttributes(hWnd, 0, 255&, LWA_ALPHA)
        nStyle = GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
            If SetWindowLong(hWnd, GWL_EXSTYLE, nStyle) Then
                DetachTransparency = CBool(SetWindowLong(hWnd, GWL_EXSTYLE, nStyle))
            End If
    End If
End Function