24H2动态壁纸无法正常嵌入（针对vb.net的紧急加更）

这个24H2已经有了好长时间了，为什么到25年下半年才被我发现，那是因为没有24H2版本的电脑啊！

之前那个台式机不知为何不能更新到24H2，而大家对于24H2桌面壁纸异常的问题也都得到了解决，这一次可能有些仓促，我直接给出讲核心代码

参考文献：

这个博主专门研究了24H2版本壁纸和Progman的WorkerW问题，我按照ta的思路写了VB.net版本的代码，目前仍在测试阶段，代码为测试代码，已经较为完善，需要根据需要修改！

最值得注意的就是，设置窗口为不透明，根据需要加，最好加上去！

vbnet 复制代码

SetLayeredWindowAttributes(hWnd, 0, 255, LWA_ALPHA)

vbnet 复制代码

Public BackLo As Point
Dim sendMessageBack As IntPtr
Const GWL_EXSTYLE As Integer = -20
Const WS_EX_LAYERED = &H80000
Public Const LWA_ALPHA As Integer = &H2
Const HWND_BOTTOM = 1
Const HWND_TOP = 0
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const SWP_NOACTIVATE = &H10
Const SW_SHOW = 5
Const WS_EX_NOACTIVATE = &H8000000L

Declare Auto Function GetWindowLong Lib "user32" (ByVal hWnd As IntPtr, ByVal nIndex As Integer) As Integer
Declare Auto Function SetWindowLong Lib "user32" (ByVal hWnd As IntPtr, ByVal nIndex As Integer, ByVal dwNewLong As Integer) As Integer

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click


    BackPalyer.Show()
    Dim hWnd = BackPalyer.Handle
    '24H2
    Dim ProgmanPtr = FindWindow("Progman", Nothing)
    Dim WorkerW As IntPtr
    '激活WorkerW
    SendMessageTimeout(ProgmanPtr, &H52C, IntPtr.Zero, IntPtr.Zero, 0, &H3E8, sendMessageBack)
    '查找子窗口获得句柄
    WorkerW = FindWindowEx(ProgmanPtr, IntPtr.Zero, "WorkerW", Nothing)

    Dim DefView As IntPtr
    DefView = FindWindowEx(ProgmanPtr, IntPtr.Zero, "SHELLDLL_DefView", Nothing)
    ' 获取窗口当前的扩展样式
    Dim extendedStyle As Integer = GetWindowLong(hWnd, GWL_EXSTYLE)
    ' 设置新的扩展样式，增加分层样式
SetWindowLong(hWnd, GWL_EXSTYLE, extendedStyle Or WS_EX_LAYERED Or WS_EX_NOACTIVATE)

    'SetLayeredWindowAttributes(hWnd, 0, 255, LWA_ALPHA)
    '嵌入progman
    SetParent(hWnd, ProgmanPtr)

    '调整Z序
    'player
    SetWindowPos(hWnd, HWND_TOP, 0, 0, 500, 500, 0)
    'SHELLDLL_DefView 桌面图标窗口

    SetWindowPos(DefView, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE)
    'WorkerW

    SetWindowPos(WorkerW, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE)

    ShowWindow(hWnd, SW_SHOW)
    ShowWindow(DefView, SW_SHOW)
    ShowWindow(WorkerW, SW_SHOW)
  End Sub

Public Shared Function RefreshBack() As Boolean
    Dim wallpaper As New StringBuilder(200)
    SystemParametersInfo(&H73, 200, wallpaper, 0)
    Dim returnValue As Integer = SystemParametersInfo(20, 1, wallpaper, 3)
    If returnValue <> 0 Then
        Dim currentUserRegistry As RegistryKey = Registry.CurrentUser
        Dim desktopRegistry As RegistryKey = currentUserRegistry.CreateSubKey("Control Panel\Desktop\")
        desktopRegistry.SetValue("Wallpaper", wallpaper.ToString())
        Return True
    End If
    Return False
End Function

Private Sub Form1_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
    BackPalyer.Close()
    RefreshBack()
End Sub

效果：

系统版本号暂时为纯正24H2------26100.1

注意：测试过程中，如果在Player窗口处于焦点状态，那么可能会改变Progman窗口的Z序，解决方法就是嵌入进去就把焦点失去给到别的窗口

vbnet 复制代码

' 设置新的扩展样式，增加分层样式
SetWindowLong(hWnd, GWL_EXSTYLE, extendedStyle Or WS_EX_LAYERED Or WS_EX_NOACTIVATE)