Attribute VB_Name = "Module1"
Option Explicit

' BOOL SetLayeredWindowAttributes(
'   HWND hwnd,      // handle to the layered window
'   COLORREF crKey,   // specifies the color key
'   BYTE bAlpha,      // value for the blend function
'   DWORD 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 Const LWA_COLORKEY = &H1&
Private Const LWA_ALPHA = &H2&

' Style setting APIs
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

' Win32 APIs to determine OS information.
Private Declare Function GetVersionEx Lib "kernel32" _
   Alias "GetVersionExA" (lpVersionInformation As _
   OSVERSIONINFO) As Long
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 Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

' Used to determine parentage.
Private Declare Function GetParent Lib "User32" (ByVal _
   hWnd As Long) As Long
Private Declare Function IsWindowVisible Lib "User32" _
   (ByVal hWnd As Long) As Long

Public Function ClearWindowTranslucency(ByVal hWnd As _
   Long) As Boolean
   Dim nStyle As Long
   If IsWin2000 Then
      ' Only work with top-level.
      hWnd = GetTopLevel(hWnd)
      ' Set translucency to fully opaque (255).
      Call SetLayeredWindowAttributes(hWnd, 0, 255&, _
         LWA_ALPHA)
      ' Clear exstyle bit.
      nStyle = GetWindowLong(hWnd, GWL_EXSTYLE) And _
         Not WS_EX_LAYERED
      ClearWindowTranslucency = _
         CBool(SetWindowLong(hWnd, GWL_EXSTYLE, nStyle))
   End If
End Function

Public Function SetWindowTranslucency(ByVal hWnd As _
   Long, ByVal Alpha As Byte) As Boolean
   Dim nStyle As Long
   If IsWin2000 Then
      ' Only work with top-level.
      hWnd = GetTopLevel(hWnd)
      ' Set exstyle bit.
      nStyle = GetWindowLong(hWnd, GWL_EXSTYLE) Or _
         WS_EX_LAYERED
      If SetWindowLong(hWnd, GWL_EXSTYLE, nStyle) Then
         ' Set window translucency to
         ' requested Alpha value.
         SetWindowTranslucency = _
            CBool(SetLayeredWindowAttributes(hWnd, _
            0, CLng(Alpha), LWA_ALPHA))
      End If
   End If
End Function

Private Function IsWin2000() As Boolean
   Dim os As OSVERSIONINFO
   ' Layered windows are only available in
   ' Windows 2000. This function shouldn't
   ' be called often, so check on demand.
   os.dwOSVersionInfoSize = Len(os)
   Call GetVersionEx(os)
   If os.dwPlatformId = VER_PLATFORM_WIN32_NT Then
      IsWin2000 = (os.dwMajorVersion >= 5)
   End If
End Function

Private Function GetTopLevel(ByVal hChild As Long) _
   As Long
   Dim hWnd As Long

   ' Read parent chain up to highest visible.
   hWnd = hChild
   Do While IsWindowVisible(GetParent(hWnd))
      hWnd = GetParent(hChild)
      hChild = hWnd
   Loop
   GetTopLevel = hWnd
End Function

' OVERTECH
Public Sub GentleOpen(ByVal winObj As Object)
    Dim Counter
    For Counter = 0 To 255 Step 20
        SetWindowTranslucency winObj.hWnd, Counter
        winObj.Visible = True
        DoEvents
    Next Counter
    ClearWindowTranslucency winObj.hWnd
End Sub

Public Sub GentleClose(ByVal winObj As Object)
    Dim Counter
    For Counter = 255 To 0 Step -160
        SetWindowTranslucency winObj.hWnd, Counter
        winObj.Visible = True
        DoEvents
    Next Counter
    winObj.Visible = False
    'ClearWindowTranslucency winObj.hwnd
End Sub

Public Sub GentleActive(ByVal winObj As Object)
Exit Sub
    Dim Counter
    For Counter = 200 To 255 Step 20
        SetWindowTranslucency winObj.hWnd, 200
        winObj.Visible = True
        DoEvents
    Next Counter
    ClearWindowTranslucency winObj.hWnd
End Sub

Public Sub GentleInactive(ByVal winObj As Object)
Exit Sub
    Dim Counter
    For Counter = 255 To 200 Step -20
        SetWindowTranslucency winObj.hWnd, Counter
        winObj.Visible = True
        DoEvents
    Next Counter
    'winObj.Visible = False
    'ClearWindowTranslucency winObj.hwnd
End Sub