VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsShadow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' Drop-Shadow generator class
' Date: 10/15/02
'
'   Author: Kevin Slaughter
'      Web: http://www.Miryokuteki.com
'      email: admin@miryokuteki.com
'
' Purpose: This class demonstrates how to
' draw a decent drop shadow for any visible
' window, by alphablending on top of whatever
' image/color is below the shadow's region.
'
'
' Note: The shadow is drawn using the same
'       4-shade convention that Windows XP
'       uses around a menu (if enabled).
'
'
' Known bugs:
'   2. The shadow will not disappear
'      until another window has moved over the
'      area it was drawn on. Unfortunatly, this
'      could not be fixed without subclassing
'      the window the shadow is drawn around,
'      to detect when it has lost focus.
'
'      ** This is a problem with drawing to
'         Window's main DC, not the class.
'         I had to use this to save memory.
'         If I had created a new DC for the
'         shadow, that DC would never be removed
'         from memory until Windows was shut
'         down, for the same reason as mentioned
'         above.. Without knowing when the window
'         is no longer visible, I couldn't tell
'         when to remove the DC from memory.
'--------------------------------------------------------------------------------------

Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Function InflateRect(ByRef lpRect As RECT, x As Long, y As Long)
    lpRect.Right = (lpRect.Right + x)
    lpRect.Bottom = (lpRect.Bottom + y)
End Function
Private Function AlphaBlend(RGB1 As Long, RGB2 As Long, Alpha As Integer) As Long
'This function is from SourceCode4Free.com
Dim Alpha1 As Byte, Alpha2 As Byte
    Alpha1 = Alpha
    Alpha2 = 256 - Alpha
    
    lngSrcRed& = (RGB1 And &HFF) * Alpha1
    lngDestRed& = (RGB2l And &HFF) * Alpha2
    lngSrcGreen& = ((RGB1 \ 256) And &HFF) * Alpha1
    lngDestGreen& = ((RGB2 \ 256) And &HFF) * Alpha2
    lngSrcBlue& = ((RGB1 \ 65536) And &HFF) * Alpha1
    lngDestBlue& = ((RGB2 \ 65536) And &HFF) * Alpha2
    
    AlphaBlend = RGB((lngDestRed& + lngSrcRed&) \ 256, (lngDestGreen& + lngSrcGreen&) \ 256, (lngDestBlue& + lngSrcBlue&) \ 256)
End Function
Private Function DrawOuterRect(mRct As RECT, TDC As Long, AlphaLevel As Integer)
    Dim i As Long
    
    
    If AlphaLevel = 60 Then
        SetPixel TDC, mRct.Left - 1, mRct.Bottom, AlphaBlend(GetPixel(TDC, mRct.Left - 1, mRct.Bottom), &H0, 120)
        SetPixel TDC, mRct.Left - 2, mRct.Bottom, AlphaBlend(GetPixel(TDC, mRct.Left - 2, mRct.Bottom), &H0, 180)
        SetPixel TDC, mRct.Left - 3, mRct.Bottom, AlphaBlend(GetPixel(TDC, mRct.Left - 3, mRct.Bottom), &H0, 240)
        
        SetPixel TDC, mRct.Right, mRct.Top - 1, AlphaBlend(GetPixel(TDC, mRct.Right, mRct.Top - 1), &H0, 120)
        SetPixel TDC, mRct.Right, mRct.Top - 2, AlphaBlend(GetPixel(TDC, mRct.Right, mRct.Top - 2), &H0, 180)
        SetPixel TDC, mRct.Right, mRct.Top - 3, AlphaBlend(GetPixel(TDC, mRct.Right, mRct.Top - 3), &H0, 240)
    End If
    If AlphaLevel = 120 Then
        SetPixel TDC, mRct.Left - 1, mRct.Bottom, AlphaBlend(GetPixel(TDC, mRct.Left - 1, mRct.Bottom), &H0, 180)
        SetPixel TDC, mRct.Left - 2, mRct.Bottom, AlphaBlend(GetPixel(TDC, mRct.Left - 2, mRct.Bottom), &H0, 240)
        
        SetPixel TDC, mRct.Right, mRct.Top - 1, AlphaBlend(GetPixel(TDC, mRct.Right, mRct.Top - 1), &H0, 180)
        SetPixel TDC, mRct.Right, mRct.Top - 2, AlphaBlend(GetPixel(TDC, mRct.Right, mRct.Top - 2), &H0, 240)
    End If
    If AlphaLevel = 180 Then
        SetPixel TDC, mRct.Left - 1, mRct.Bottom, AlphaBlend(GetPixel(TDC, mRct.Left - 1, mRct.Bottom), &H0, 240)
        
        SetPixel TDC, mRct.Right, mRct.Top - 1, AlphaBlend(GetPixel(TDC, mRct.Right, mRct.Top - 1), &H0, 240)
    End If
    
    
    
    For i = mRct.Left To (mRct.Right - 1)
        SetPixel TDC, i, mRct.Bottom, AlphaBlend(GetPixel(TDC, i, mRct.Bottom), &H0, AlphaLevel)
    Next i
    For i = mRct.Top To (mRct.Bottom - 1)
        SetPixel TDC, mRct.Right, i, AlphaBlend(GetPixel(TDC, mRct.Right, i), &H0, AlphaLevel)
    Next i
    If AlphaLevel > 60 Then
        SetPixel TDC, mRct.Right - 1, mRct.Bottom - 1, AlphaBlend(GetPixel(TDC, mRct.Right - 1, mRct.Bottom - 1), &H0, AlphaLevel)
    End If
End Function
Private Function DrawShadow(boxRct As RECT, TargetDC As Long)
    If (boxRct.Bottom - boxRct.Top) > 10 Then
        boxRct.Top = (boxRct.Top + ((boxRct.Bottom - boxRct.Top) / 10))
    End If
    
    If (boxRct.Right - boxRct.Left) > 10 Then
        boxRct.Left = (boxRct.Left + ((boxRct.Right - boxRct.Left) / 10))
    End If
    '---------
    
    DrawOuterRect boxRct, TargetDC, 60
    Dim a As Long
    
    For a = 2 To 4
        InflateRect boxRct, 1, 1
            boxRct.Left = (boxRct.Left + 1): boxRct.Top = (boxRct.Top + 1)
        DrawOuterRect boxRct, TargetDC, 60 * a
    Next a
End Function

Public Function ShadowWindow(hWnd As Long)
    Dim gRct As RECT, DeskDC As Long
    GetWindowRect hWnd, gRct
    DeskDC = GetDC(0)
    DrawShadow gRct, DeskDC
End Function

Private Sub Class_Initialize()
    'Blah
End Sub

Private Sub Class_Terminate()
    'Blah
End Sub
