2 Attachment(s)
Windows 11 effects applied on borderless form
I have build my own system of menus based on a VBCCR toolbar. I use forms with BorderStyle=0 to popup my menus.
Attachment 196128
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.
Attachment 196129
Has someone encountered the same problem ?
Here is the code I use :
Code:
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
Re: Windows 11 effects applied on borderless form
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
Re: Windows 11 effects applied on borderless form
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.
Re: Windows 11 effects applied on borderless form
Re: Windows 11 effects applied on borderless form
Quote:
Originally Posted by
Eduardo-
Thank you for the link, it works fine.