BORDERLESS VBA USERFORMDWM API AERO SOFT SHADOW SIMULATION

Rahmenlose Excel VBA Userform GUI incl. Windows Aero Frame und weichen Schatten ( GPU-beschleunigt ) DWMAPI.DLL [ Windows 7/8/10 x86 ]

Frameless/Borderless Excel VBA Userform GUI incl. Windows Aero frame and soft shadows ( GPU accelerated ) dwmapi.dll [ Windows 7/8/10 x86 ]

API
DWMAPI.DLL
CODE LANGUAGE
VBA Visual Basic for Applications
CODE LINES
<108>

Stay Hungry, Stay Foolish -Steve Jobs Apple
'//// VBA DWM API AERO SOFT SHADOW SIMULATION
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Option Explicit
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal H_WINDOW As Long, ByVal lngWinIdx As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal H_WINDOW As Long, ByVal lngWinIdx As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal H_WINDOW As Long, ByVal crKey As Integer, ByVal bAlpha As Integer, ByVal dwFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal H_WINDOW As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal H_WINDOW As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal H_WINDOW As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal H_WINDOW As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function DwmSetWindowAttribute Lib "dwmapi" (ByVal hWnd As Long, ByVal attr As Integer, ByRef attrValue As Integer, ByVal attrSize As Integer) As Long
Private Declare Function DwmExtendFrameIntoClientArea Lib "dwmapi" (ByVal hWnd As Long, ByRef NEWMARGINS As MARGINS) As Long
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Type POINTAPI
    X As Long
    Y As Long
End Type
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Const GWL_STYLE = (-16)
Private Const WS_CAPTION = &HC00000 '//// WS_BORDER Or WS_DLGFRAME
Private Const WS_BORDER = &H800000
Private Const GWL_EXSTYLE As Long = (-20) '//// OFFSET OF WINDOW EXTENDED STYLE
Private Const WS_EX_DLGMODALFRAME As Long = &H1 '//// CONTROLS IF WINDOW HAS AN ICON
Private Const SC_CLOSE As Long = &HF060
Private Const SW_SHOW As Long = 5
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const WS_EX_TRANSPARENT = &H20&
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Enum ESetWindowPosStyles
    SWP_SHOWWINDOW = &H40
    SWP_HIDEWINDOW = &H80
    SWP_FRAMECHANGED = &H20 '//// FRAME CHANGED SEND WM_NCCALCSIZE
    SWP_NOACTIVATE = &H10
    SWP_NOCOPYBITS = &H100
    SWP_NOMOVE = &H2
    SWP_NOOWNERZORDER = &H200 '// DONT DO OWNER Z ORDERING
    SWP_NOREDRAW = &H8
    SWP_NOREPOSITION = SWP_NOOWNERZORDER
    SWP_NOSIZE = &H1
    SWP_NOZORDER = &H4
    SWP_DRAWFRAME = SWP_FRAMECHANGED
    HWND_NOTOPMOST = -2
End Enum
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Type MARGINS
    leftWidth As Long
    rightWidth As Long
    topHeight As Long
    bottomHeight As Long
End Type
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Const HTCAPTION = 2
Private XWNDFORM, XWNDFORMEX As Long
Private Const WM_NCLBUTTONDOWN = &HA1
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub UserForm_Activate()

    Dim ISTYLE, HWNDFORM As Long
    Dim BTRANS As Byte
    BTRANS = 128
    Dim NEWMARGINS As MARGINS
    
    HWNDFORM = FindWindow(vbNullString, Me.Caption) '//// GET WINDOW

    ISTYLE = GetWindowLong(HWNDFORM, GWL_STYLE) '//// BASIC WINDOW STYLE FLAGS FOR THE FORM
    ISTYLE = ISTYLE And Not WS_CAPTION '//// NO CAPTION AREA
    SetWindowLong HWNDFORM, GWL_STYLE, ISTYLE '//// SET BASIC WINDOW STYLES

    ISTYLE = GetWindowLong(HWNDFORM, GWL_EXSTYLE) '//// BUILD EXTENDED WINDOW STYLE
    ISTYLE = ISTYLE And Not WS_EX_DLGMODALFRAME '//// NO BORDER

    'ISTYLE = ISTYLE Or WS_EX_LAYERED '//// ADD ONE COLOR TRANSPARENCE
    'ISTYLE = ISTYLE Or WS_EX_TRANSPARENT '//// ADD SEMI-TRANSPARENT WINDOW

    SetWindowLong HWNDFORM, GWL_EXSTYLE, ISTYLE

    'SetLayeredWindowAttributes HWNDFORM, vbCyan, BTRANS, LWA_ALPHA     '//// SEMI TRANSPARENT WINDOW
    'SetLayeredWindowAttributes HWNDFORM, vbCyan, BTRANS, LWA_COLORKEY  '//// COLOR SCREEN TRNSPARENCY

    XWNDFORM = FindWindow("ThunderDFrame", vbNullString) '//// GET NEW WINDOW

    DwmSetWindowAttribute XWNDFORM, 2, 2, 4 '//// DWMAPI

        With NEWMARGINS
        .rightWidth = 1   '//// -1
        .leftWidth = 1   '//// -1
        .topHeight = 1 '//// -1
        .bottomHeight = 1  '//// -1
    End With
   
    DwmExtendFrameIntoClientArea XWNDFORM, NEWMARGINS '//// DWMAPI
        
    DrawMenuBar HWNDFORM '//// CLEAN MENU BAR
    
    Me.Width = Me.Width - 5 '//// FRAMECUT BALANCE OFFSET
    Me.Height = Me.Height - 23 '//// FRAMECUT BALANCE OFFSET

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'//// SCRIPT © WWW.PARIS-STUDIOS.DE ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

Cookies make it easier for us to provide you with our services. With the usage of our services you permit us to use cookies.
More information Ok