Windows 11 effects applied on borderless form

[Crapahute]

I have build my own system of menus based on a VBCCR toolbar. I use forms with BorderStyle=0 to popup my menus.



Now I have tested my program on a more recent version of Windows 11 and I lose the rounded corners and the blur shadow.

I have adapted my code for the rounded corners, but I can’t reproduce the Windows 11 shadow.



Has someone encountered the same problem ?

Here is the code I use :

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DwmSetWindowAttribute Lib "dwmapi" (ByVal hWnd As Long, ByVal dwAttribute As Long, ByRef pvAttribute As Any, ByVal cbAttribute As Long) As Long
Private Declare Function DwmExtendFrameIntoClientArea Lib "dwmapi" (ByVal hWnd As Long, pMarInset As RECT) As Long
Private Const DWMWA_WINDOW_CORNER_PREFERENCE = 33
Private Const DWMWCP_ROUND = 2

Public Sub ApplyRoundedCorners(frm As Object)
' If we are on Windows 11 and the build is < 26200, we don't need to apply this sub
' as ApplyWin11Effects() does the work.
    If IsWindows11 Then
        If WinVerBuild < 26200 Then Exit Sub
    End If

Dim hRgn As Long
    ' Cut form
    hRgn = CreateRoundRectRgn(0, 0, frm.ScaleWidth + 1, frm.ScaleHeight + 1, 14, 14)
    SetWindowRgn frm.hWnd, hRgn, True
    
    DrawFormRect frm, 14
    
End Sub

Public Sub ApplyWin11Effects(frm As Form)
'This only works on Windows 11 Build < 26200.
'For the other vesions, we use ApplyRoundedCorners() for rounded corners.
    If IsWindows11 = False Then Exit Sub
    If WinVerBuild >= 26200 Then Exit Sub
    
    On Error Resume Next
    Dim Pref As Long
    Dim rc As RECT

    Pref = DWMWCP_ROUND

    '--------------------------------------
    ' Rounded corners Win11
    '--------------------------------------
    DwmSetWindowAttribute frm.hWnd, DWMWA_WINDOW_CORNER_PREFERENCE, Pref, 4
    
    '--------------------------------------
    ' DWM Shadow
    '--------------------------------------
    rc.Left = 1
    rc.Top = 1
    rc.Right = 1
    rc.Bottom = 1

    DwmExtendFrameIntoClientArea frm.hWnd, rc

End Sub

[DrBobby]

I want to say the printer combos made by Fafalone and Wqweto in this thread had the drop shadow. Might be able steal or ask how to do it from there. https://www.vbforums.com/showthread....-exist-for-vb6

[Crapahute]

Thank you, but it does not work for me.

I have found this from The trick :
https://www.vbforums.com/showthread....=1#post4984181

It works but it is way too slow with glitch when my menu pops up.

As I understand, the way Windows 11 displays its shadow has changed (DWM and DwmSetWindowAttribute) so old vb6 borderless forms can't have this kind of shadow.

[Eduardo-]

maybe this: https://leandroascierto.com/blog/tag/shadow/

[Crapahute]

maybe this: https://leandroascierto.com/blog/tag/shadow/

Thank you for the link, it works fine.