[Erledigt]Desktop Hintergrund DC ermitteln

[Axolotl]

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

[Axolotl]

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.)

[Axolotl]

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.

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() 

[ccode_new]

Okay,
hier mal ein funktionierender code ....

Funzt!

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.

[Axolotl]

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.

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() 

[tft]

Das sieht schon mal cool aus.... schaun wa mal was wir daraus machen können.

[Axolotl]

Hi,

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 

[tft]

Hallo,

super genial. Danke führ eure Mitwirkung. Wenn ich was draus gebaut habe. Poste ich es hier.

Gruss TFT

[tft]

Hallo

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]

Hallo

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()