Тень от формы

Option Explicit
 
Private Type tagINITCOMMONCONTROLSEX
    dwSize  As Long
    dwICC   As Long
End Type
 
Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (lpInitCtrls As tagINITCOMMONCONTROLSEX) As Boolean
Private Declare Function SetWindowTheme Lib "UxTheme.dll" (ByVal hwnd As Long, ByVal pszSubAppName As Long, ByVal pszSubIdList As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UpdateWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function InvalidateRect Lib "user32.dll" (ByVal hwnd As Long, lpRect As Any, ByVal bErase As Long) As Long
Private Declare Function RedrawWindow Lib "user32.dll" (ByVal hwnd As Long, lprcUpdate As Any, ByVal hrgnUpdate As Long, ByVal flags As Long) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Sub SetThemeAppProperties Lib "UxTheme.dll" (ByVal dwFlags As Long)
 
Private Const STAP_ALLOW_WEBCONTENT As Long = 4&
Private Const STAP_ALLOW_CONTROLS   As Long = 2&
Private Const STAP_ALLOW_NONCLIENT  As Long = 1&
 
Private Const WM_THEMECHANGED   As Long = &H31A&
 
Private Const RDW_ERASE         As Long = &H4
Private Const RDW_FRAME         As Long = &H400
Private Const RDW_INTERNALPAINT As Long = &H2
Private Const RDW_INVALIDATE    As Long = &H1
Private Const RDW_ALLCHILDREN   As Long = &H80
 
Private Const GWL_EXSTYLE       As Long = -20&
Private Const GWL_STYLE         As Long = -16&
 
 
Private Sub Command1_Click()
    Static StyleOFF As Boolean
    
    If Not StyleOFF Then
        'switch OFF
        StyleOFF = True
        SetWindowTheme Command1.hwnd, StrPtr(" "), StrPtr(" ")
    Else
        'switch ON
        StyleOFF = False
        SetWindowTheme Command1.hwnd, StrPtr("Explorer"), 0&
    End If
    
End Sub
 
Private Sub Command2_Click()
    SetThemeAppProperties STAP_ALLOW_NONCLIENT
    SendUpdate
End Sub
 
Private Sub Command3_Click()
    SetThemeAppProperties STAP_ALLOW_CONTROLS
    SendUpdate
End Sub
 
Private Sub Command4_Click()
    SetThemeAppProperties STAP_ALLOW_WEBCONTENT
    SendUpdate
End Sub
 
Private Sub Command5_Click()
    SetThemeAppProperties STAP_ALLOW_NONCLIENT Or STAP_ALLOW_CONTROLS Or STAP_ALLOW_WEBCONTENT
    SendUpdate
End Sub
 
Private Sub Command6_Click()
    SetThemeAppProperties 0&
    SendUpdate
End Sub
 
Private Sub SendUpdate()
    SendMessage Me.hwnd, WM_THEMECHANGED, 0&, ByVal 0&
    'Me.Refresh
    'Me.Hide
    'Me.Show
    'UpdateWindow Me.HWnd
    'InvalidateRect Me.HWnd, ByVal 0&, 1&
    'Me.Move Me.Left, Me.Top
    RedrawWindow Me.hwnd, ByVal 0&, 0&, RDW_ERASE Or RDW_FRAME Or RDW_INTERNALPAINT Or RDW_INVALIDATE Or RDW_ALLCHILDREN    '----> XP refresh support
End Sub
 
Private Sub Form_Initialize()
    Dim ICC As tagINITCOMMONCONTROLSEX
    ' Enable visual styles
    With ICC
        .dwSize = Len(ICC)
        .dwICC = &HFF& 'http://www.geoffchappell.com/studies/windows/shell/comctl32/api/commctrl/initcommoncontrolsex.htm
    End With
    InitCommonControlsEx ICC
End Sub
 
Private Sub Form_Load()
    Dim Style As Long
    'Style = GetWindowLong(Command2.hwnd, GWL_STYLE)
    'SetWindowLong Command2.hwnd, GWL_STYLE, Style Or &H800000
    'Debug.Print Style
End Sub