[Erledigt]Desktop Hintergrund DC ermitteln
Re: Desktop Hintergrund DC ermitteln
HI ccode_new,
wenn ich so einen code aus dem Ärmel schütteln würde, hätte ich das tatsächlich gemacht.
Bisher habe ich immer transparente Fenster gemacht und die auf dem Desktop platziert. (Desktop-Uhr und so weiter).
Hinter die Icons wollte ich noch nie zeichnen...
Aber irgendwie bin ich neugierig geworden. Mal sehen
wenn ich so einen code aus dem Ärmel schütteln würde, hätte ich das tatsächlich gemacht.
Bisher habe ich immer transparente Fenster gemacht und die auf dem Desktop platziert. (Desktop-Uhr und so weiter).
Hinter die Icons wollte ich noch nie zeichnen...
Aber irgendwie bin ich neugierig geworden. Mal sehen
Mostly running PureBasic <latest stable version and current alpha/beta> (x64) on Windows 11 Home
Re: Desktop Hintergrund DC ermitteln
Hi tft,
der Link von dir ist mMn schon der Schubs in die richtige Richtung.
Meine kurze Zusammenfassung:
Program-Manager zum erzeugen eines "Zwischen-Fensters" bewegen, durch eine undokumentierte Nachricht ohne Namen (0x052C).
Dann das passende Handle finden: Problem Von Fenster mit Classname WorkerW ohne Titel gibt es wohl mehrere.
Dieses WorkerW Fenster setzt man dann als Parent des eigenen Fensters.
Mal schauen, ob ich das nach PB konvertieren kann.....
@ccode_new: ja, wieder kein Code (ich muss jetzt erst mal Green Bay Packers gucken.)
der Link von dir ist mMn schon der Schubs in die richtige Richtung.
Meine kurze Zusammenfassung:
Program-Manager zum erzeugen eines "Zwischen-Fensters" bewegen, durch eine undokumentierte Nachricht ohne Namen (0x052C).
Dann das passende Handle finden: Problem Von Fenster mit Classname WorkerW ohne Titel gibt es wohl mehrere.
Dieses WorkerW Fenster setzt man dann als Parent des eigenen Fensters.
Mal schauen, ob ich das nach PB konvertieren kann.....
@ccode_new: ja, wieder kein Code (ich muss jetzt erst mal Green Bay Packers gucken.)
Mostly running PureBasic <latest stable version and current alpha/beta> (x64) on Windows 11 Home
Re: Desktop Hintergrund DC ermitteln
Okay,
hier mal ein funktionierender code ....
Nebenwirkungen habe ich noch nicht rausgefunden, außer das mein Desktop jetzt eine fiese Farbe hat.
Wer es sehen möchte muss nur Mutig sein und auf den Knopf drücken.
hier mal ein funktionierender code ....
Nebenwirkungen habe ich noch nicht rausgefunden, außer das mein Desktop jetzt eine fiese Farbe hat.
Wer es sehen möchte muss nur Mutig sein und auf den Knopf drücken.
Code: Alles auswählen
Global hWorkerW = 0
; Procedure that will be called for each window...
Procedure.l EnumProcedure(hWnd, Parameter)
Static found = 0
Protected h, hworker, Title$, Class$
h = FindWindowEx_(hWnd, 0, @"SHELLDLL_DefView", 0) ;' gets first child
If h :Debug "SHELLDLL_DefView - hwnd = "+h
hworker = FindWindowEx_(0, hWnd, @"WorkerW", 0) ;' gets the WorkerW Window after the current one.
If hworker :Debug "WorkerW - hwnd = "+hworker
hWorkerW = hworker
EndIf
EndIf
ProcedureReturn 1 ; returning <> 0 will continue till all windows are searched
EndProcedure
Procedure Test()
Protected hWnd, hdc, hBrush, clientRect.RECT
hWnd = FindWindowEx_(0, 0, @"Progman", 0) :Debug "Progman - hwnd = "+hwnd
;LRESULT SendMessageTimeoutW(HWND hWnd, UINT Msg, WPARAM wParam, LPARAM lParam, UINT fuFlags, UINT uTimeout, PDWORD_PTR lpdwResult);
If SendMessageTimeout_(hWnd, #WM_NULL, #Null, #Null, #SMTO_ABORTIFHUNG, 1000, #Null)
Debug "We can still communicate with the window..."
If SendMessageTimeout_(hWnd, $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 windows "
EnumWindows_(@EnumProcedure(), 0) ; the 0 will be passed in Paremeter.l to the procedure
If hWorkerW <> 0 :Debug "hWorkerW "
hdc = GetDCEx_(hWorkerW, 0, $403)
; hBrush = CreateSolidBrush_(GetSysColor_(#COLOR_BTNFACE))
hBrush = CreateSolidBrush_(GetSysColor_(#COLOR_INFOBK))
GetClientRect_(hWorkerW, @clientRect) :Debug "yes "
FillRect_(hdc, @clientRect, hBrush)
ReleaseDC_(hWorkerW, hdc)
EndIf
EndIf
EndIf
EndProcedure
Procedure Main()
Protected count
If OpenWindow(0, 80, 80, 230, 90, "Example...", #PB_Window_SystemMenu );| #PB_Window_ScreenCentered)
ButtonGadget (1, 10, 10, 200, 20, "Click me")
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case 1
Test()
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
EndIf
EndProcedure
End Main()
Mostly running PureBasic <latest stable version and current alpha/beta> (x64) on Windows 11 Home
Re: Desktop Hintergrund DC ermitteln
Funzt!Axolotl hat geschrieben:Okay,
hier mal ein funktionierender code ....
Die letzte Stelle beim WorkerW-Handle war bei mir immer um 2 Stellen falsch.
Z.Bsp.:
Benötigt: $20732
Geliefert: $20734
Die Sache mit dem EnumWindows_(..) finde ich hierbei recht interessant.
Betriebssysteme: div. Windows, Linux, Unix - Systeme
no Keyboard, press any key
no mouse, you need a cat
no Keyboard, press any key
no mouse, you need a cat
Re: Desktop Hintergrund DC ermitteln
Komisch...
Ich bin mir auch nicht sicher, dass nicht irgendwelche Benutzereingaben und Programaufrufe die Reihenfolge der Fenster durcheinanderbringen.
Zum Beispiel macht WIN+Tab den Desktop wieder richtig.
Ich habe noch ein "aktives" Beispiel "Fenster mit CountDown" gebastelt.
Ich bin mir auch nicht sicher, dass nicht irgendwelche Benutzereingaben und Programaufrufe die Reihenfolge der Fenster durcheinanderbringen.
Zum Beispiel macht WIN+Tab den Desktop wieder richtig.
Ich habe noch ein "aktives" Beispiel "Fenster mit CountDown" gebastelt.
Code: Alles auswählen
;' File : DrawToDesktopBehindIcons.pb
;' based on C#/C++ Code
;' LINK: https://www.codeproject.com/Articles/856020/Draw-Behind-Desktop-Icons-in-Windows-plus
;'
EnableExplicit
;' 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
h = FindWindowEx_(hWnd, 0, @"SHELLDLL_DefView", 0) ;' gets first child
If h :Debug "SHELLDLL_DefView: "+InspectVar(h)
hworker = FindWindowEx_(0, hWnd, @"WorkerW", 0) ;' gets the WorkerW Window after the current one.
If hworker :Debug "WorkerW: "+InspectVar(hworker)
*Param\i = hworker ;' return this by Argument
EndIf
EndIf
ProcedureReturn 1 ; returning <> 0 will continue till all windows are searched
EndProcedure ;()
Procedure.i GetWallpaperWindow() ;' returns handle of WorkerW or zero
Protected hwndWallpaper, hwndProgMan
;' fetch the Progman window
hwndProgMan = FindWindowEx_(0, 0, @"Progman", 0) :Debug " "+InspectVar(hwndProgMan)
;' 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..."
;' 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 "
;' 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)
EndIf
EndIf
EndIf
;' return the handle you're looking for.
ProcedureReturn hwndWallpaper
EndProcedure ;()
Procedure Test(State=0)
Static hwndWallpaper, hWnd = 0
Protected r, hdc, hBrush, clientRect.RECT
If State = 0 ;' find the Wallpaper
hwndWallpaper = GetWallpaperWindow()
If hwndWallpaper <> 0 :Debug " "+InspectVar(hwndWallpaper)
; hdc = GetDCEx_(hwndWallpaper, 0, $403)
; ; hBrush = CreateSolidBrush_(GetSysColor_(#COLOR_BTNFACE))
; hBrush = CreateSolidBrush_(GetSysColor_(#COLOR_INFOBK))
;
GetClientRect_(hwndWallpaper, @clientRect) :Debug " "+InspectRect(clientRect)
; FillRect_(hdc, @clientRect, hBrush)
; ReleaseDC_(hwndWallpaper, hdc)
r = SetParent_(WindowID(1), hwndWallpaper) :Debug " SetParent return "+r
EndIf
ElseIf State = 1 ;' get away from this
If hwndWallpaper <> 0
r = SetParent_(WindowID(1), 0) :Debug " SetParent return "+r
; r = SendMessage_(hwndWallpaper, #WM_CLOSE, 0, 0) :Debug " WM_CLOSE return code = "+r
GetClientRect_(hwndWallpaper, @clientRect) :Debug " "+InspectRect(clientRect)
; RedrawWindow_(hwndWallpaper, @clientRect, 0, #RDW_INVALIDATE| #RDW_ERASE | #RDW_UPDATENOW)
; 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
EndProcedure ;()
Procedure x_Test()
; Protected hWorkW
; Protected hWnd, hdc, hBrush, clientRect.RECT
;
; hWnd = FindWindowEx_(0, 0, @"Progman", 0) :Debug "Progman - hwnd = "+hwnd
;
; ;LRESULT SendMessageTimeoutW(HWND hWnd, UINT Msg, WPARAM wParam, LPARAM lParam, UINT fuFlags, UINT uTimeout, PDWORD_PTR lpdwResult);
; If SendMessageTimeout_(hWnd, #WM_NULL, #Null, #Null, #SMTO_ABORTIFHUNG, 1000, #Null)
; Debug "We can still communicate with the window..."
;
; If SendMessageTimeout_(hWnd, $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 windows "
; EnumWindows_(@EnumProcedure(), @hWorkW) ; the hWorkW will receive the right window handle in the procedure
; Debug "Compare "+hWorkerW+" == "+hWorkW : If hWorkerW = hWorkW : Debug " +--> yes that works." : EndIf
;
; If hWorkerW <> 0 :Debug "hWorkerW "
; hdc = GetDCEx_(hWorkerW, 0, $403)
; ; hBrush = CreateSolidBrush_(GetSysColor_(#COLOR_BTNFACE))
; hBrush = CreateSolidBrush_(GetSysColor_(#COLOR_INFOBK))
;
; GetClientRect_(hWorkerW, @clientRect) :Debug " "+InspectRect(clientRect)
; FillRect_(hdc, @clientRect, hBrush)
;
; ReleaseDC_(hWorkerW, hdc)
; EndIf
; EndIf
; EndIf
; ; EnumWindows_(@EnumProcedure(), 0) ; the 0 will be passed in Paremeter.l to the procedure
EndProcedure
Procedure MoveSecondWindow()
ResizeWindow(1, WindowX(0), WindowY(0)-WindowHeight(1)-20, #PB_Ignore, #PB_Ignore)
EndProcedure
Procedure Main()
Protected Event, CountDown = 10
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)
TextGadget(0, 0, 10, 230, 60, "count down", #PB_Text_Center)
SetGadgetFont(0, LoadFont(0, "Arial", 48))
EndIf
If OpenWindow(0, 80, 180, 230, 200, "Example...", #PB_Window_SystemMenu )
ButtonGadget (1, 10, 10, 200, 20, "Find Wallpaper")
ButtonGadget (2, 10, 40, 200, 20, "Reset Countdown")
ButtonGadget (3, 10, 70, 200, 20, " Wallpaper ?")
; 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(CountDown))
CountDown - 1
EndIf
If CountDown < 0
CountDown = 10
; 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 : CountDown = 10 ; reset count down
Case 3 : Test(1) ; get rid of it -- TODO not working at this time
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
RemoveWindowTimer(1, 1)
; SHChangeNotify_($8000000, $1000, 0, 0) ;' not figured out what this constants mean
EndIf
EndProcedure
End Main()
Mostly running PureBasic <latest stable version and current alpha/beta> (x64) on Windows 11 Home
- tft
- Beiträge: 605
- Registriert: 08.09.2004 20:18
- Computerausstattung: GTX Titan , i9 9900K , 32 GB Ram , 500 GB SSD , 3 ASUS FullHD Monitore and more
- Wohnort: Dachsen
- Kontaktdaten:
Re: Desktop Hintergrund DC ermitteln
Das sieht schon mal cool aus.... schaun wa mal was wir daraus machen können.
TFT seid 1989 , Turgut Frank Temucin , Dachsen/Berlin/Antalya
Aktuelles Projekte : Driving School Evergarden
YouTube : Pure Basic to go
FaceBook : Temuçin SourceMAgic Games
DISCORD : SourceMagic
W10 , i9 9900K ,32 GB Ram , GTX Titan , 3 Monitore FHD
ARDUINO Freak
Aktuelles Projekte : Driving School Evergarden
YouTube : Pure Basic to go
FaceBook : Temuçin SourceMAgic Games
DISCORD : SourceMagic
W10 , i9 9900K ,32 GB Ram , GTX Titan , 3 Monitore FHD
ARDUINO Freak
Re: Desktop Hintergrund DC ermitteln
Hi,
um mit Programmende wieder alles schön zu haben, folgenden Code ergänzen und am Ende die
UpdateWallpaperFilename() aufrufen.
um mit Programmende wieder alles schön zu haben, folgenden Code ergänzen und am Ende die
UpdateWallpaperFilename() aufrufen.
Code: Alles auswählen
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$
file$ = GetWallpaperFilename()
If file$ <> ""
SetWallpaperFilename(file$)
EndIf
EndProcedure
Mostly running PureBasic <latest stable version and current alpha/beta> (x64) on Windows 11 Home
- tft
- Beiträge: 605
- Registriert: 08.09.2004 20:18
- Computerausstattung: GTX Titan , i9 9900K , 32 GB Ram , 500 GB SSD , 3 ASUS FullHD Monitore and more
- Wohnort: Dachsen
- Kontaktdaten:
Re: Desktop Hintergrund DC ermitteln
Hallo,
super genial. Danke führ eure Mitwirkung. Wenn ich was draus gebaut habe. Poste ich es hier.
Gruss TFT
super genial. Danke führ eure Mitwirkung. Wenn ich was draus gebaut habe. Poste ich es hier.
Gruss TFT
TFT seid 1989 , Turgut Frank Temucin , Dachsen/Berlin/Antalya
Aktuelles Projekte : Driving School Evergarden
YouTube : Pure Basic to go
FaceBook : Temuçin SourceMAgic Games
DISCORD : SourceMagic
W10 , i9 9900K ,32 GB Ram , GTX Titan , 3 Monitore FHD
ARDUINO Freak
Aktuelles Projekte : Driving School Evergarden
YouTube : Pure Basic to go
FaceBook : Temuçin SourceMAgic Games
DISCORD : SourceMagic
W10 , i9 9900K ,32 GB Ram , GTX Titan , 3 Monitore FHD
ARDUINO Freak
- tft
- Beiträge: 605
- Registriert: 08.09.2004 20:18
- Computerausstattung: GTX Titan , i9 9900K , 32 GB Ram , 500 GB SSD , 3 ASUS FullHD Monitore and more
- Wohnort: Dachsen
- Kontaktdaten:
Re: Desktop Hintergrund DC ermitteln
Hallo
damit der Code auch beim Bewegen des Fenster funktioniert. Musste ich eine wenig bei den Bindings ändern und dem Timer.
damit der Code auch beim Bewegen des Fenster funktioniert. Musste ich eine wenig bei den Bindings ändern und dem Timer.
Code: Alles auswählen
;' File : DrawToDesktopBehindIcons.pb
;' based on C#/C++ Code
;' LINK: https://www.codeproject.com/Articles/856020/Draw-Behind-Desktop-Icons-in-Windows-plus
;'
; Modyfy by TFT 20.1.2021
;
EnableExplicit
#EventForce = 1
Global CountDown = 10
;' 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
h = FindWindowEx_(hWnd, 0, @"SHELLDLL_DefView", 0) ;' gets first child
If h :Debug "SHELLDLL_DefView: "+InspectVar(h)
hworker = FindWindowEx_(0, hWnd, @"WorkerW", 0) ;' gets the WorkerW Window after the current one.
If hworker :Debug "WorkerW: "+InspectVar(hworker)
*Param\i = hworker ;' return this by Argument
EndIf
EndIf
ProcedureReturn 1 ; returning <> 0 will continue till all windows are searched
EndProcedure ;()
Procedure.i GetWallpaperWindow() ;' returns handle of WorkerW or zero
Protected hwndWallpaper, hwndProgMan
;' fetch the Progman window
hwndProgMan = FindWindowEx_(0, 0, @"Progman", 0) :Debug " "+InspectVar(hwndProgMan)
;' 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..."
;' 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 "
;' 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)
EndIf
EndIf
EndIf
;' return the handle you're looking for.
ProcedureReturn hwndWallpaper
EndProcedure ;()
Procedure Test(State=0)
Static hwndWallpaper, hWnd = 0
Protected r, hdc, hBrush, clientRect.RECT
If State = 0 ;' find the Wallpaper
hwndWallpaper = GetWallpaperWindow()
If hwndWallpaper <> 0 :Debug " "+InspectVar(hwndWallpaper)
; hdc = GetDCEx_(hwndWallpaper, 0, $403)
; ; hBrush = CreateSolidBrush_(GetSysColor_(#COLOR_BTNFACE))
; hBrush = CreateSolidBrush_(GetSysColor_(#COLOR_INFOBK))
;
GetClientRect_(hwndWallpaper, @clientRect) :Debug " "+InspectRect(clientRect)
; FillRect_(hdc, @clientRect, hBrush)
; ReleaseDC_(hwndWallpaper, hdc)
r = SetParent_(WindowID(1), hwndWallpaper) :Debug " SetParent return "+r
EndIf
ElseIf State = 1 ;' get away from this
If hwndWallpaper <> 0
r = SetParent_(WindowID(1), 0) :Debug " SetParent return "+r
; r = SendMessage_(hwndWallpaper, #WM_CLOSE, 0, 0) :Debug " WM_CLOSE return code = "+r
GetClientRect_(hwndWallpaper, @clientRect) :Debug " "+InspectRect(clientRect)
; RedrawWindow_(hwndWallpaper, @clientRect, 0, #RDW_INVALIDATE| #RDW_ERASE | #RDW_UPDATENOW)
; 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
EndProcedure ;()
Procedure x_Test()
; Protected hWorkW
; Protected hWnd, hdc, hBrush, clientRect.RECT
;
; hWnd = FindWindowEx_(0, 0, @"Progman", 0) :Debug "Progman - hwnd = "+hwnd
;
; ;LRESULT SendMessageTimeoutW(HWND hWnd, UINT Msg, WPARAM wParam, LPARAM lParam, UINT fuFlags, UINT uTimeout, PDWORD_PTR lpdwResult);
; If SendMessageTimeout_(hWnd, #WM_NULL, #Null, #Null, #SMTO_ABORTIFHUNG, 1000, #Null)
; Debug "We can still communicate with the window..."
;
; If SendMessageTimeout_(hWnd, $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 windows "
; EnumWindows_(@EnumProcedure(), @hWorkW) ; the hWorkW will receive the right window handle in the procedure
; Debug "Compare "+hWorkerW+" == "+hWorkW : If hWorkerW = hWorkW : Debug " +--> yes that works." : EndIf
;
; If hWorkerW <> 0 :Debug "hWorkerW "
; hdc = GetDCEx_(hWorkerW, 0, $403)
; ; hBrush = CreateSolidBrush_(GetSysColor_(#COLOR_BTNFACE))
; hBrush = CreateSolidBrush_(GetSysColor_(#COLOR_INFOBK))
;
; GetClientRect_(hWorkerW, @clientRect) :Debug " "+InspectRect(clientRect)
; FillRect_(hdc, @clientRect, hBrush)
;
; ReleaseDC_(hWorkerW, hdc)
; EndIf
; EndIf
; EndIf
; ; EnumWindows_(@EnumProcedure(), 0) ; the 0 will be passed in Paremeter.l to the procedure
EndProcedure
Procedure Timer()
Shared CountDown
Select EventTimer()
Case #EventForce
; Dieser Code Teil muss in die TimerEvent Procedure, Weil sonst beim bewegen des Fensters
; Das Programm bei WaitEvent stehen bleibt. Ein bekanntes Problem ab W 7 durch die einfürung
; des Binding Systems
SetGadgetText(0, Str(CountDown))
CountDown - 1
If CountDown < 0
CountDown = 10
EndIf
EndSelect
EndProcedure
Procedure MoveSecondWindow()
ResizeWindow(1, WindowX(0), WindowY(0)-WindowHeight(1)-20, #PB_Ignore, #PB_Ignore)
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$
file$ = GetWallpaperFilename()
If file$ <> ""
SetWallpaperFilename(file$)
EndIf
EndProcedure
Procedure Main()
Protected Event
Shared CountDown
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)
TextGadget(0, 0, 10, 230, 60, "count down", #PB_Text_Center)
SetGadgetFont(0, LoadFont(0, "Arial", 48))
EndIf
If OpenWindow(0, 80, 180, 230, 200, "Example...", #PB_Window_SystemMenu )
ButtonGadget (1, 10, 10, 200, 20, "Find Wallpaper")
ButtonGadget (2, 10, 40, 200, 20, "Reset Countdown")
ButtonGadget (3, 10, 70, 200, 20, "Wallpaper ?")
; Protected hwndMain = GetWindowLongPtr_(WindowID(0), #GWL_HWNDPARENT) :Debug InspectVar(hwndMain)
; Protected hwndForm = GetWindowLongPtr_(WindowID(1), #GWL_HWNDPARENT) :Debug InspectVar(hwndForm)
AddWindowTimer(1, #EventForce, 1000)
BindEvent(#PB_Event_MoveWindow, @MoveSecondWindow(), 0)
BindEvent(#PB_Event_Timer, @Timer(), 1) ; Das funktioniert nur, da es an das andere Fenster gebunden ist.
; Da müssen die Parameter noch besser gesetzt werden
Repeat
Event = WaitWindowEvent(20)
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case 1 : Test(0) ; find wallpaper
Case 2 : CountDown = 10 ; reset count down
Case 3 : Test(1) ; get rid of it -- TODO not working at this time
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
RemoveWindowTimer(1, 1)
UnbindEvent(#PB_Event_MoveWindow, @MoveSecondWindow(), 0)
Test(1)
Delay(100)
UpdateWallpaperFilename()
EndIf
EndProcedure
End Main()
TFT seid 1989 , Turgut Frank Temucin , Dachsen/Berlin/Antalya
Aktuelles Projekte : Driving School Evergarden
YouTube : Pure Basic to go
FaceBook : Temuçin SourceMAgic Games
DISCORD : SourceMagic
W10 , i9 9900K ,32 GB Ram , GTX Titan , 3 Monitore FHD
ARDUINO Freak
Aktuelles Projekte : Driving School Evergarden
YouTube : Pure Basic to go
FaceBook : Temuçin SourceMAgic Games
DISCORD : SourceMagic
W10 , i9 9900K ,32 GB Ram , GTX Titan , 3 Monitore FHD
ARDUINO Freak
- tft
- Beiträge: 605
- Registriert: 08.09.2004 20:18
- Computerausstattung: GTX Titan , i9 9900K , 32 GB Ram , 500 GB SSD , 3 ASUS FullHD Monitore and more
- Wohnort: Dachsen
- Kontaktdaten:
Re: Desktop Hintergrund DC ermitteln
Hallo
damit der Code auch beim Bewegen des Fenster funktioniert. Musste ich eine wenig bei den Bindings ändern und dem Timer.
damit der Code auch beim Bewegen des Fenster funktioniert. Musste ich eine wenig bei den Bindings ändern und dem Timer.
Code: Alles auswählen
;' File : DrawToDesktopBehindIcons.pb
;' based on C#/C++ Code
;' LINK: https://www.codeproject.com/Articles/856020/Draw-Behind-Desktop-Icons-in-Windows-plus
;'
; Modyfy by TFT 20.1.2021
;
EnableExplicit
#EventForce = 1
Global CountDown = 10
;' 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
h = FindWindowEx_(hWnd, 0, @"SHELLDLL_DefView", 0) ;' gets first child
If h :Debug "SHELLDLL_DefView: "+InspectVar(h)
hworker = FindWindowEx_(0, hWnd, @"WorkerW", 0) ;' gets the WorkerW Window after the current one.
If hworker :Debug "WorkerW: "+InspectVar(hworker)
*Param\i = hworker ;' return this by Argument
EndIf
EndIf
ProcedureReturn 1 ; returning <> 0 will continue till all windows are searched
EndProcedure ;()
Procedure.i GetWallpaperWindow() ;' returns handle of WorkerW or zero
Protected hwndWallpaper, hwndProgMan
;' fetch the Progman window
hwndProgMan = FindWindowEx_(0, 0, @"Progman", 0) :Debug " "+InspectVar(hwndProgMan)
;' 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..."
;' 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 "
;' 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)
EndIf
EndIf
EndIf
;' return the handle you're looking for.
ProcedureReturn hwndWallpaper
EndProcedure ;()
Procedure Test(State=0)
Static hwndWallpaper, hWnd = 0
Protected r, hdc, hBrush, clientRect.RECT
If State = 0 ;' find the Wallpaper
hwndWallpaper = GetWallpaperWindow()
If hwndWallpaper <> 0 :Debug " "+InspectVar(hwndWallpaper)
; hdc = GetDCEx_(hwndWallpaper, 0, $403)
; ; hBrush = CreateSolidBrush_(GetSysColor_(#COLOR_BTNFACE))
; hBrush = CreateSolidBrush_(GetSysColor_(#COLOR_INFOBK))
;
GetClientRect_(hwndWallpaper, @clientRect) :Debug " "+InspectRect(clientRect)
; FillRect_(hdc, @clientRect, hBrush)
; ReleaseDC_(hwndWallpaper, hdc)
r = SetParent_(WindowID(1), hwndWallpaper) :Debug " SetParent return "+r
EndIf
ElseIf State = 1 ;' get away from this
If hwndWallpaper <> 0
r = SetParent_(WindowID(1), 0) :Debug " SetParent return "+r
; r = SendMessage_(hwndWallpaper, #WM_CLOSE, 0, 0) :Debug " WM_CLOSE return code = "+r
GetClientRect_(hwndWallpaper, @clientRect) :Debug " "+InspectRect(clientRect)
; RedrawWindow_(hwndWallpaper, @clientRect, 0, #RDW_INVALIDATE| #RDW_ERASE | #RDW_UPDATENOW)
; 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
EndProcedure ;()
Procedure x_Test()
; Protected hWorkW
; Protected hWnd, hdc, hBrush, clientRect.RECT
;
; hWnd = FindWindowEx_(0, 0, @"Progman", 0) :Debug "Progman - hwnd = "+hwnd
;
; ;LRESULT SendMessageTimeoutW(HWND hWnd, UINT Msg, WPARAM wParam, LPARAM lParam, UINT fuFlags, UINT uTimeout, PDWORD_PTR lpdwResult);
; If SendMessageTimeout_(hWnd, #WM_NULL, #Null, #Null, #SMTO_ABORTIFHUNG, 1000, #Null)
; Debug "We can still communicate with the window..."
;
; If SendMessageTimeout_(hWnd, $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 windows "
; EnumWindows_(@EnumProcedure(), @hWorkW) ; the hWorkW will receive the right window handle in the procedure
; Debug "Compare "+hWorkerW+" == "+hWorkW : If hWorkerW = hWorkW : Debug " +--> yes that works." : EndIf
;
; If hWorkerW <> 0 :Debug "hWorkerW "
; hdc = GetDCEx_(hWorkerW, 0, $403)
; ; hBrush = CreateSolidBrush_(GetSysColor_(#COLOR_BTNFACE))
; hBrush = CreateSolidBrush_(GetSysColor_(#COLOR_INFOBK))
;
; GetClientRect_(hWorkerW, @clientRect) :Debug " "+InspectRect(clientRect)
; FillRect_(hdc, @clientRect, hBrush)
;
; ReleaseDC_(hWorkerW, hdc)
; EndIf
; EndIf
; EndIf
; ; EnumWindows_(@EnumProcedure(), 0) ; the 0 will be passed in Paremeter.l to the procedure
EndProcedure
Procedure Timer()
Shared CountDown
Select EventTimer()
Case #EventForce
; Dieser Code Teil muss in die TimerEvent Procedure, Weil sonst beim bewegen des Fensters
; Das Programm bei WaitEvent stehen bleibt. Ein bekanntes Problem ab W 7 durch die einfürung
; des Binding Systems
SetGadgetText(0, Str(CountDown))
CountDown - 1
If CountDown < 0
CountDown = 10
EndIf
EndSelect
EndProcedure
Procedure MoveSecondWindow()
ResizeWindow(1, WindowX(0), WindowY(0)-WindowHeight(1)-20, #PB_Ignore, #PB_Ignore)
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$
file$ = GetWallpaperFilename()
If file$ <> ""
SetWallpaperFilename(file$)
EndIf
EndProcedure
Procedure Main()
Protected Event
Shared CountDown
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)
TextGadget(0, 0, 10, 230, 60, "count down", #PB_Text_Center)
SetGadgetFont(0, LoadFont(0, "Arial", 48))
EndIf
If OpenWindow(0, 80, 180, 230, 200, "Example...", #PB_Window_SystemMenu )
ButtonGadget (1, 10, 10, 200, 20, "Find Wallpaper")
ButtonGadget (2, 10, 40, 200, 20, "Reset Countdown")
ButtonGadget (3, 10, 70, 200, 20, "Wallpaper ?")
; Protected hwndMain = GetWindowLongPtr_(WindowID(0), #GWL_HWNDPARENT) :Debug InspectVar(hwndMain)
; Protected hwndForm = GetWindowLongPtr_(WindowID(1), #GWL_HWNDPARENT) :Debug InspectVar(hwndForm)
AddWindowTimer(1, #EventForce, 1000)
BindEvent(#PB_Event_MoveWindow, @MoveSecondWindow(), 0)
BindEvent(#PB_Event_Timer, @Timer(), 1) ; Das funktioniert nur, da es an das andere Fenster gebunden ist.
; Da müssen die Parameter noch besser gesetzt werden
Repeat
Event = WaitWindowEvent(20)
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case 1 : Test(0) ; find wallpaper
Case 2 : CountDown = 10 ; reset count down
Case 3 : Test(1) ; get rid of it -- TODO not working at this time
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
RemoveWindowTimer(1, 1)
UnbindEvent(#PB_Event_MoveWindow, @MoveSecondWindow(), 0)
Test(1)
Delay(100)
UpdateWallpaperFilename()
EndIf
EndProcedure
End Main()
TFT seid 1989 , Turgut Frank Temucin , Dachsen/Berlin/Antalya
Aktuelles Projekte : Driving School Evergarden
YouTube : Pure Basic to go
FaceBook : Temuçin SourceMAgic Games
DISCORD : SourceMagic
W10 , i9 9900K ,32 GB Ram , GTX Titan , 3 Monitore FHD
ARDUINO Freak
Aktuelles Projekte : Driving School Evergarden
YouTube : Pure Basic to go
FaceBook : Temuçin SourceMAgic Games
DISCORD : SourceMagic
W10 , i9 9900K ,32 GB Ram , GTX Titan , 3 Monitore FHD
ARDUINO Freak