on my windows 10 (x64) computer I use this piece of code, I made this several month ago on a request in the german forum.
I made a small update to the example.
Please keep in mind, that it works with an unique colored background.
I do tests only on my computer with 4k (96dpi) single monitor setting. (no multimonitor setting tested!)
Code: Select all
;''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
;' File : DrawToDesktopBehindIcons.pb
;' Author : Andreas Halter
;' Target OS : Windows
;' License : Free, unrestricted, no warranty whatsoever
;' Use at your own risk
;' German Forum: https://www.purebasic.fr/german/viewtopic.php?f=3&t=32228
;'
;' based on C#/C++ Code
;' LINK: https://www.codeproject.com/Articles/856020/Draw-Behind-Desktop-Icons-in-Windows-plus
;' This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)
;'
EnableExplicit
;DebugLevel 9 ;' Remove comment mark to see all Debug Messages :)
;' Debugging helpers
Macro DQ
"
EndMacro
Macro InspectRect(rcVar)
DQ#rcVar#DQ+" = "+Str(rcVar\left)+", "+Str(rcVar\top)+", "+Str(rcVar\right)+", "+Str(rcVar\bottom)+" "
EndMacro
Macro InspectVar(iVar)
DQ#iVar#DQ+" = 0x"+Hex(iVar)+" ("+Str(iVar)+") "
EndMacro
;' EnumWindows that will be called for each window...
Procedure __EnumWindowsProc(hWnd, *Param.INTEGER) ;' returns the found hWnd as *Param
Protected h, hworker ;:Debug #PB_Compiler_Procedure+"()", 9
h = FindWindowEx_(hWnd, 0, @"SHELLDLL_DefView", 0) ;' gets first child
If h ;:Debug " SHELLDLL_DefView: "+InspectVar(h), 9
hworker = FindWindowEx_(0, hWnd, @"WorkerW", 0) ;' gets the WorkerW Window after the current one.
If hworker ;:Debug " WorkerW: "+InspectVar(hworker), 9
*Param\i = hworker ;' return this by Argument
EndIf
EndIf ;:Debug "", 9
ProcedureReturn 1 ; returning <> 0 will continue till all windows are searched
EndProcedure ;()
Procedure.i GetWallpaperWindow() ;' returns handle of WorkerW or zero
Protected hwndWallpaper, hwndProgMan :Debug #PB_Compiler_Procedure+"()", 9
;' fetch the Progman window
hwndProgMan = FindWindowEx_(0, 0, @"Progman", 0) :Debug " "+InspectVar(hwndProgMan), 9
;' check - not needed, doesn't hurt
If SendMessageTimeout_(hwndProgMan, #WM_NULL, #Null, #Null, #SMTO_ABORTIFHUNG, 1000, #Null)
Debug " We can still communicate with the window...", 9
;' Send 0x052C to Progman. This message directs Progman to spawn a
;' WorkerW behind the desktop icons. If it is already there, nothing happens.
;' MSDN: LRESULT SendMessageTimeoutW(HWND hWnd, UINT Msg, WPARAM wParam, LPARAM lParam, UINT fuFlags, UINT uTimeout, PDWORD_PTR lpdwResult);
;'
;' HINT: SendMessage with 0x52c, 0xD, 0x1 (or 0) allows the Worker window with high resolution ??
;'
If SendMessageTimeout_(hwndProgMan, $052C, #Null, #Null, #SMTO_NORMAL, 1000, #Null) = 0
Debug " Error " + GetLastError_()
;If GetLastError_() <> #error_timeout
; to get extended error information, call GetLastError.
; If GetLastError returns ERROR_TIMEOUT, then the function timed out.
Else
Debug " Look for the wallpaper window, now ", 9
;' We enumerate all Windows, until we find one, that has the SHELLDLL_DefView as a child.
;' If we found that window, we take its next sibling and assign it to workerw.
; HWND wallpaper_hwnd = nullptr;
; EnumWindows(EnumWindowsProc, (LPARAM)&wallpaper_hwnd);
hwndWallpaper = 0
EnumWindows_(@__EnumWindowsProc(), @hwndWallpaper) ;' the hwndWallpaper will get the window handle
If hwndWallpaper <> 0
Debug " found "+InspectVar(hwndWallpaper), 9
EndIf
EndIf
EndIf :Debug "", 9
;' return the handle you're looking for.
ProcedureReturn hwndWallpaper
EndProcedure ;()
Procedure.s GetWallpaperFilename()
Protected fn${#MAX_PATH}
SystemParametersInfo_(#SPI_GETDESKWALLPAPER, #MAX_PATH, @fn$, 0)
ProcedureReturn fn$
EndProcedure ;()
Procedure SetWallpaperFilename(Filename$)
SystemParametersInfo_(#SPI_SETDESKWALLPAPER, 0, @Filename$, #SPIF_UPDATEINIFILE | #SPIF_SENDWININICHANGE)
EndProcedure ;()
Procedure UpdateWallpaperFilename()
Protected file$ :Debug #PB_Compiler_Procedure+"()", 9
file$ = GetWallpaperFilename()
If file$ <> ""
SetWallpaperFilename(file$) :Debug " Wallpaper '"+file$+"'", 9
EndIf :Debug "", 9
EndProcedure ;()
Procedure.i GetPixelColorAtCoordinate(X, Y)
Protected hDC, result
hDC = GetDC_(0)
result = GetPixel_(hDC, X, Y)
ReleaseDC_(0, hDC)
ProcedureReturn result
EndProcedure ;()
Procedure DrawBackground(hwnd)
Protected r, hdc, hBrush, clientRect.RECT
hdc = GetDCEx_(hwnd, 0, $403)
If hdc
; ; hBrush = CreateSolidBrush_(GetSysColor_(#COLOR_BTNFACE))
;hBrush = CreateSolidBrush_(GetSysColorBrush_(#COLOR_INFOBK))
hBrush = CreateSolidBrush_(GetPixelColorAtCoordinate(1, 1)) ; I use solid background color (try pixel 1,1)
GetClientRect_(hwnd, @clientRect) :Debug " "+InspectRect(clientRect), 9
FillRect_(hdc, @clientRect, hBrush)
DeleteObject_(hBrush)
ReleaseDC_(hwnd, hdc)
EndIf
EndProcedure ;()
Procedure Test(State=0)
Static hwndWallpaper, hWnd = 0 :Debug #PB_Compiler_Procedure+"()", 9
Protected r, hdc, hBrush, clientRect.RECT
hwndWallpaper = GetWallpaperWindow() :Debug " "+InspectVar(hwndWallpaper)
If State = 0 ;' look for Wallpaper
If hwndWallpaper <> 0 :Debug " "+InspectVar(hwndWallpaper), 9
GetClientRect_(hwndWallpaper, @clientRect) :Debug " "+InspectRect(clientRect), 9
r = SetParent_(WindowID(1), hwndWallpaper) :Debug " SetParent return "+r, 9
EndIf
ElseIf State = 1 ;' get away from this
If hwndWallpaper <> 0
r = SetParent_(WindowID(1), 0) :Debug " SetParent return "+r, 9
; r = SendMessage_(hwndWallpaper, #WM_CLOSE, 0, 0) :Debug " WM_CLOSE return code = "+r
GetClientRect_(hwndWallpaper, @clientRect) :Debug " "+InspectRect(clientRect), 9
DrawBackground(hwndWallpaper)
; RedrawWindow_(hwndWallpaper, @clientRect, 0, #RDW_INVALIDATE| #RDW_ERASE|#RDW_UPDATENOW)
;RedrawWindow_(hwndWallpaper, #Null, #Null, #RDW_INVALIDATE|#RDW_ERASE)
; InvalidateRect(hwnd, NULL, TRUE);
;
; SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, IntPtr.Zero, null, SMTO_ABORTIFHUNG, 100, IntPtr.Zero);
;
; If SendMessageTimeout_(#HWND_BROADCAST, #WM_SETTINGCHANGE, #Null, #Null, #SMTO_ABORTIFHUNG, 1000, #Null)
; If SendMessageTimeout_(hwndWallpaper, #WM_SETTINGCHANGE, #Null, #Null, #SMTO_ABORTIFHUNG, 1000, #Null)
; Debug "refresh ..."
; EndIf
; hWnd = GetWindow_(hwndWallpaper, #GW_HWNDPREV)
; If hWnd <> 0
; SetWindowPos_(hwndWallpaper, hWnd, 0, 0, 0, 0, #SWP_NOMOVE|#SWP_NOSIZE|#SWP_NOACTIVATE)
; EndIf
;; SystemParametersInfo_(#SPI_SETDESKWALLPAPER, 0, tempPath, #SPIF_UPDATEINIFILE | #SPIF_SENDWININICHANGE);
EndIf
; SHChangeNotify_($8000000, $1000, 0, 0)
EndIf :Debug "", 9
EndProcedure ;()
Procedure MoveSecondWindow()
ResizeWindow(1, WindowX(0), WindowY(0)-WindowHeight(1)-20, #PB_Ignore, #PB_Ignore)
EndProcedure
Procedure Main()
Protected Event, Count, tmp :Debug #PB_Compiler_Procedure+"()", 9
;' window behind the Icons (no accessable by user)
If OpenWindow(1, 80, 80, 230, 80, "Example...", #PB_Window_SystemMenu|#PB_Window_BorderLess)
SetWindowLongPtr_(WindowID(1), #GWL_STYLE, GetWindowLongPtr_(WindowID(1), #GWL_STYLE) & ~#WS_CAPTION)
tmp = GetPixelColorAtCoordinate(1, 1)
SetWindowColor(1, tmp)
TextGadget(0, 0, 10, 230, 60, "count", #PB_Text_Center)
SetGadgetColor(0, #PB_Gadget_BackColor, tmp)
SetGadgetFont(0, LoadFont(0, "Arial", 48))
EndIf
;' window to control the stuff
If OpenWindow(0, 80, 180, 330, 200, "Example: Move Window behind Icons", #PB_Window_SystemMenu)
ButtonGadget(1, 10, 10, 300, 20, "1. Add Wallpaper-Window")
ButtonGadget(3, 10, 40, 300, 20, "2. Remove Wallpaper-Window")
ButtonGadget(2, 10, 80, 300, 20, "Reset Count")
; Protected hwndMain = GetWindowLongPtr_(WindowID(0), #GWL_HWNDPARENT) :Debug InspectVar(hwndMain)
; Protected hwndForm = GetWindowLongPtr_(WindowID(1), #GWL_HWNDPARENT) :Debug InspectVar(hwndForm)
BindEvent(#PB_Event_MoveWindow, @MoveSecondWindow(), 0)
AddWindowTimer(1, 1, 1000)
Repeat
Event = WaitWindowEvent(20)
Select Event
Case #PB_Event_Timer
If EventTimer() = 1
SetGadgetText(0, Str(Count))
Count + 1
EndIf
If Count > 1000
Count = 1
; event = #PB_Event_CloseWindow
EndIf
Case #PB_Event_MoveWindow ;:Debug "moving window "
ResizeWindow(1, WindowX(0), WindowY(0)-WindowHeight(1)-20, #PB_Ignore, #PB_Ignore)
; SetWindowPos_(hwndWallpaper, hWnd, 0, 0, 0, 0, #SWP_NOMOVE|#SWP_NOSIZE|#SWP_NOACTIVATE)
Case #PB_Event_Gadget
Select EventGadget()
Case 1 : Test(0) ; find wallpaper
Case 2 : Count = 0 ; restart count :)
Case 3 : Test(1) ; get rid of it
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
RemoveWindowTimer(1, 1)
; Debug RedrawWindow_(#Null, #Null, #Null, #RDW_INVALIDATE|#RDW_ERASE) ;' Desktop Window, all update regions -- If the function succeeds, the return value is nonzero.
; Debug InvalidateRect_(#Null, #Null, #True) ; all windows, all regions
;UpdateWallpaperFilename()
EndIf :Debug "", 9
EndProcedure
End Main()