Attribute VB_Name = "Translucency"
Dim mbWindows98orHigher As Boolean

Const VER_PLATFORM_WIN32s = 0
Const VER_PLATFORM_WIN32_WINDOWS = 1
Const VER_PLATFORM_WIN32_NT = 2

Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion      As Long
    dwMinorVersion      As Long
    dwBuildNumber       As Long
    dwPlatformId        As Long
    szCSDVersion        As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias _
    "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

'hWnd    - handle to window to layer.
'crKey   - specifies the color key
'bAlpha  - value for the blend function
'dwFlags - action
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 Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1&
Private Const LWA_ALPHA = &H2&
Private Const WS_EX_TRANSPARENT = &H20&
Private Const GWL_STYLE = (-16)
Public Declare Function DrawMenuBar Lib "user32" (ByVal Hwnd As Long) As Long

Public Declare Function EnableWindow Lib "user32" (ByVal Hwnd As Long, ByVal fEnable 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 Function fGetOSVersion()
Dim os As OSVERSIONINFO
' Returns True if Win98 or Win2000
fGetOSVersion = False
With os
    .dwOSVersionInfoSize = Len(os)
    Call GetVersionEx(os)
    ' Windows 2000
    If .dwMajorVersion > 4 Then fGetOSVersion = True
    If .dwMajorVersion = 4 And _
       .dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
       .dwMinorVersion > 0 Then
        fGetOSVersion = True
    End If
End With
End Function

Public Function fSetTranslucency(ByVal Hwnd As Long, ByVal Alpha As Byte) As Boolean
Dim lStyle As Long
' Layering only works with Win2K or above.
If fIsWin2000 Then
    ' Only a top level window can be translucent.
    Hwnd = fGetTopLevel(Hwnd)
    ' Make the window translucent by setting its
    ' extended style.
    lStyle = GetWindowLong(Hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
    If SetWindowLong(Hwnd, GWL_EXSTYLE, lStyle) Then
        fSetTranslucency = CBool(SetLayeredWindowAttributes(Hwnd, 0, CLng(Alpha), LWA_ALPHA))
    End If
End If
End Function
Public Function fClearTranslucency(ByVal Hwnd As Long) As Boolean
Dim lStyle As Long
' Layering only works with Win2K or above.
If fIsWin2000 Then
    ' Only a top level window can be translucent.
    Hwnd = fGetTopLevel(Hwnd)
    ' Clear translucency - make the window opaque.
    Call SetLayeredWindowAttributes(Hwnd, 0, 255&, LWA_ALPHA)
    ' Clear the extended style bit.
    lStyle = GetWindowLong(Hwnd, GWL_EXSTYLE) And Not WS_EX_LAYERED
    fClearTranslucency = CBool(SetWindowLong(Hwnd, GWL_EXSTYLE, lStyle))
End If
End Function


Public Function fIsWin2000() As Boolean
Dim os As OSVERSIONINFO
' Returns True if Win98 or Win2000
fIsWin2000 = False
With os
    .dwOSVersionInfoSize = Len(os)
    Call GetVersionEx(os)
    ' Windows 2000
    If .dwPlatformId = VER_PLATFORM_WIN32_NT Then
        fIsWin2000 = (.dwMajorVersion > 4)
    End If
End With
End Function

Public Function fGetTopLevel(ByVal hChild As Long) As Long
Dim Hwnd As Long
Hwnd = hChild
Do While IsWindowVisible(GetParent(Hwnd))
    Hwnd = GetParent(hChild)
    hChild = Hwnd
Loop
fGetTopLevel = Hwnd
End Function

Public Function ClearForm(ByVal Hwnd As Long) As Boolean
    Dim lStyle As Long
    If SetWindowLong(Hwnd, GWL_STYLE, WS_EX_TRANSPARENT) Then
        ClearForm = CBool(SetLayeredWindowAttributes(Hwnd, 0, CByte(Alpha), 0))
    End If
End Function
