animate desktop background windows 8+

[idle]

draw a window screen behind icons, cobbled together from code from Axilotol and inspired by Jbaker and Mijikai's lib
which makes it easy

viewtopic.php?t=77538

note not tested for multiple monitors

Run it from ide
press Windowskey + D
hit escape to end
press Windowskey + D

Code: Select all

InitSprite()
InitKeyboard()

ExamineDesktops() 

Global hwndWallpaper,hworker,width,height 
Global gEnd,myKeyhook

width = DesktopWidth(0)
height = DesktopHeight(0) 

Structure akey
  ks.a[256]
EndStructure 

Structure matrix  
  ncols.i
  nrows.i
  total.i 
  twidth.i
  theight.i 
  gcount.i
  Array depth.i(0) 
  Array mat.i(0)
  Array spmatrix.i(0)
EndStructure   

Global matrix.matrix
Global font 
font = LoadFont(#PB_Any,"Arial",height/8,#PB_Font_HighQuality | #PB_Font_Bold)

Procedure.i KeyProc(nCode.l,wParam.l,lParam.l)
  
  Protected *keyInput.KBDLLHOOKSTRUCT 
  Static keys.akey 
  Static pos,len  
  
  Protected ret.i, hwnd.i,thwnd.i 
  Protected rs.s=Space(2) 
  Protected doc 
  
  ret = CallNextHookEx_(myKeyhook, nCode, wParam, lParam) 
  
  *keyInput = lParam 
  
  
  If nCode = #HC_ACTION 
    
    
    hwnd = GetForegroundWindow_()
    
    If hwnd =  GetActiveWindow_() 
      
      Select wParam  
          
        Case #WM_KEYUP
          
          keys\ks[*keyInput\vkCode]= $fe
          
          If (GetAsyncKeyState_(#VK_SHIFT) & $8000)  
            keys\ks[#VK_SHIFT]=$fe
          EndIf 
          
          If (GetAsyncKeyState_(#VK_CONTROL) & $8000)  
            keys\ks[#VK_CONTROL]=$fe
          EndIf 
          
          If (GetAsyncKeyState_(#VK_LMENU) & $8000)  
            keys\ks[#VK_LMENU]=$fe
          EndIf 
          
          If (GetAsyncKeyState_(#VK_RMENU) & $8000)  
            keys\ks[#VK_RMENU]=$fe
          EndIf 
          
          If (keys\ks[#VK_ESCAPE] = 0 And keys\ks[#VK_LBUTTON] = 0)
            ;If ToUnicode_(*keyInput\vkCode,*keyInput\scanCode,@keys,@rs,1,2) 
            ;   ProcessKeys(rs,keys\ks[#VK_BACK])              
            ;EndIf   
          ElseIf keys\ks[#VK_ESCAPE]   
            gend = 1 
          EndIf 
          
          keys\ks[*keyInput\vkCode]=0
          keys\ks[#VK_SHIFT]=0
          keys\ks[#VK_CONTROL]=0
          keys\ks[#VK_LMENU]=0
          keys\ks[#VK_RMENU]=0
          
      EndSelect
    EndIf 
  EndIf    
  
  ProcedureReturn ret
  
EndProcedure 

Procedure SetHooks(hInstance=0)
  
  myKeyhook = SetWindowsHookEx_(#WH_KEYBOARD_LL, @KeyProc(),hInstance,0) 
  If myKeyhook = 0    
    MessageRequester("hook", "can't get module handle")
  EndIf       
  
EndProcedure 

Procedure KillHooks()
  UnhookWindowsHookEx_(myKeyhook)
  myKeyHook = 0  
EndProcedure 

Procedure EnumWindowsProc(hWnd,*Param.INTEGER)  
  Protected h, hworker                                                         
  h = FindWindowEx_(hWnd, 0, @"SHELLDLL_DefView", 0)   
  If h                                                                        
    hworker = FindWindowEx_(0, hWnd, @"WorkerW", 0)   
    If hworker                                                                 
      *Param\i = hworker 
    EndIf 
  EndIf                                                                        
  ProcedureReturn 1      
EndProcedure

Procedure.i GetDesktopWindow() 
  Protected hwndProgMan                                         
  
  hwndProgMan = FindWindowEx_(0, 0, @"Progman", 0)                             
  
  If SendMessageTimeout_(hwndProgMan, #WM_NULL, #Null, #Null, #SMTO_ABORTIFHUNG, 1000, #Null)
    If SendMessageTimeout_(hwndProgMan, $052C, #Null, #Null, #SMTO_NORMAL, 1000, #Null) <> 0 
      hwndWallpaper = 0 
      EnumWindows_(@EnumWindowsProc(),@hwndWallpaper) 
    EndIf 
  EndIf                                                                       
  
  ProcedureReturn hwndWallpaper 
EndProcedure 

Prototype.i p_PrintWindow(hWnd, hdc, flags)
OpenLibrary(1, "User32.dll")
Global PrintWindow.p_PrintWindow = GetFunction(1, "PrintWindow")

Procedure GetWallpaper(mon=0) 
  ExamineDesktops()
  width = DesktopWidth(mon) 
  height = DesktopHeight(mon) 
  hImage = CreateImage(ImageNr,Width,Height) 
  hDC  = StartDrawing(ImageOutput(ImageNr)) 
  printwindow(GetDesktopWindow(),hdc,0) 
  StopDrawing() 
  ProcedureReturn hImage 
EndProcedure

Procedure DisplayMessageCenter(window,msg.s,color=255,scale.f=1.00)
  
  Protected spriteNumber,tempImage,fontsTextWidth,fontsTextHeight,cx,cy,a,b
  Static overlay,ct1
  
  ct1+1 
  
  If Not overlay 
    overlay = CreateSprite(#PB_Any,width,height) ;make the crt overlay   
    If overlay 
      If StartDrawing(SpriteOutput(overlay))   
        Box(0,0,width,height,RGB(1,1,1)) 
        For a = 2 To width-1 Step 2  
          For b = 2 To height-3 Step 3 
            Plot(a,b,0) 
            Plot(a,b+1,0)
          Next 
        Next
        StopDrawing() 
      EndIf  
    EndIf      
  EndIf 
  
  tempImage = CreateImage(#PB_Any,1,1)    ;if you need to get the size of a font in pixels         
  If tempImage
    If StartDrawing(ImageOutput(tempImage)) ;draw to the temp image 
      DrawingFont(FontID(font))             ;with the selected font  
      fontsTextWidth = TextWidth(msg)       ;get the width and height in pixles     
      fontsTextHeight = TextHeight(msg)  
      
      StopDrawing()  
      spriteNumber = CreateSprite(#PB_Any,fontsTextWidth,fontsTextHeight) ;create the sprite of required size 
      
      If spriteNumber 
        If StartDrawing(SpriteOutput(spriteNumber))   ;now you can draw the text to the sprite 
          DrawingFont(FontID(font)) 
          DrawText(0,0,msg,color)
          StopDrawing()
          TransparentSpriteColor(spriteNumber,0)
          cx = (((width - (fontsTextWidth*scale)) / 2)) 
          cy = (((height - (fontsTextHeight*scale)) / 2))         
          ZoomSprite(spriteNumber,fontsTextWidth*scale,fontsTextHeight*scale)  
          DisplayTransparentSprite(spriteNumber,cx-(ct1&2),cy-(ct1&1))  ;jitter the x and y ccoordinates  
        EndIf   
        FreeSprite(spriteNumber)
        TransparentSpriteColor(overlay,0)
        DisplayTransparentSprite(overlay,0,0,255)  
      EndIf 
    EndIf  
    FreeImage(tempImage)       
  EndIf 
  
EndProcedure 

Procedure InitMatrix(width,height) 
  Protected char.s,chars.s = "ﾊﾐﾋｰｳｼﾅﾓﾆｻﾜﾂｵﾘｱﾎﾃﾏｹﾒｴｶｷﾑﾕﾗｾﾈｽﾀﾇﾍ+-/*><=,.0123456789abcdefABCDEF"
  ;Protected char.s,chars.s = "бвгджзклмнпрстфхцчшщаэыуояеёюиъь+-/*><=,.0123456789ABCDEFKPUTIN" 
  Protected len = Len(chars)
  Protected a,tempImage,font,fontsTextWidth,fontsTextHeight,mx,my  
  ReDim matrix\spmatrix(len) 
  
  font = LoadFont(#PB_Any,"Arial",24,#PB_Font_HighQuality | #PB_Font_Bold)
  
  For a = 0 To len 
    tempImage = CreateImage(#PB_Any,1,1)    ;if you need to get the size of a font in pixels         
    If tempImage
      If StartDrawing(ImageOutput(tempImage)) ;draw to the temp image 
        DrawingFont(FontID(font))             ;with the selected font  
        char.s = Mid(chars,a,1)
        fontsTextWidth = TextWidth(char)       ;get the width and height in pixles     
        fontsTextHeight = TextHeight(char)   
        If fontsTextWidth > mx 
          mx = fontsTextWidth 
        EndIf 
        If fontsTextHeight > my 
          my = fontsTextHeight 
        EndIf 
        StopDrawing()  
        
        matrix\spmatrix(a) = CreateSprite(#PB_Any,fontsTextWidth,fontsTextHeight) ;create the sprite of required size 
        If matrix\spmatrix(a) 
          If StartDrawing(SpriteOutput(matrix\spmatrix(a)))   ;now you can draw the text to the sprite 
            DrawingFont(FontID(font)) 
            DrawingFont(FontID(font)) 
            DrawText(0,0,char,RGB(1,1,1))
            StopDrawing()
          EndIf  
        EndIf
      EndIf
      FreeImage(tempImage)   
    EndIf 
  Next 
  
  matrix\ncols = width / (mx)
  matrix\nrows = height / (my)
  matrix\twidth = mx 
  matrix\theight = my 
  matrix\total =  matrix\ncols *  matrix\nrows
  ReDim matrix\mat(matrix\total)
  ReDim matrix\depth(matrix\ncols) 
  
  For a = 0 To matrix\ncols 
    matrix\depth(a) = Random(matrix\nrows,0) 
  Next 
  
  For a = 0 To matrix\total
    matrix\mat(a) = matrix\spmatrix(Random(ArraySize(matrix\spmatrix()),1)) 
  Next 
  
EndProcedure 

Procedure DrawMatrix(color) 
  Protected a,xx,yy,sp
  Protected sfy.f = (0-255) / (0-matrix\nrows)
  Static et,et1,col
  
  For a = 0 To matrix\total-1 
    xx = a / matrix\nrows 
    yy = a % matrix\nrows 
    sp = matrix\mat(a) 
    DisplayTransparentSprite(sp,(xx*matrix\twidth),(yy * matrix\theight), matrix\depth(xx)*sfy-(yy*sfy),color) 
    
  Next    
  
  If ElapsedMilliseconds() > et 
    For a = 0 To matrix\ncols  
      matrix\depth(a) = Random(matrix\nrows,10) 
    Next   
    et = ElapsedMilliseconds()+250
  EndIf  
  If ElapsedMilliseconds() > et1 
    For a = 0 To matrix\total
      matrix\mat(a) = matrix\spmatrix(Random(ArraySize(matrix\spmatrix()),1)) 
    Next 
    et1 = ElapsedMilliseconds()+125
  EndIf  
  
EndProcedure  

Global spwallpaper,  wallpaper = GetWallpaper()
Global  width,height 
ExamineDesktops() 
width = DesktopWidth(0)
height = DesktopHeight(0) 

hwnd = GetDesktopWindow() 
If hwnd 
  
  hdc = GetDC_(hwnd)
  If hdc
    
    OpenWindow(0,0,0,0,0,"",#PB_Window_Invisible)
    
    SetHooks(GetModuleHandle_(0))
    
    If OpenWindowedScreen(hwnd, 0, 0, width, height)
      
      spwallpaper = CreateSprite(#PB_Any,width,height)
      StartDrawing(SpriteOutput(spwallpaper)) 
      DrawImage(wallpaper,0,0) 
      StopDrawing() 
           
      initmatrix(width,height)
      
      Repeat
        
        Repeat 
        Until WindowEvent()= 0
        
        If gend 
          DisplayTransparentSprite(spwallpaper,0,0,255) 
          FlipBuffers() 
          Break 
        EndIf  
        
        FlipBuffers() 
        
        ClearScreen(0)
        color=RGB(0,255,0)
        drawMatrix(color)
        DisplayMessageCenter(0,FormatDate("%hh:%ii:%ss", Date()),color)
                
        Delay(1)
        
      ForEver 
      
      CloseScreen()
      ReleaseDC_(hwnd,hdc) 
      CloseWindow(0) 
    EndIf
  EndIf 
EndIf  
End 

[infratec]

Some hints

After starting the program from the IDE, you have to minimize the IDE to see the running program.

To stop you have to click into the desktop and press ESC.

[idle]

Some hints

After starting the program from the IDE, you have to minimize the IDE to see the running program.

To stop you have to click into the desktop and press ESC.

I added instructions

[BarryG]

The code does nothing here - it just runs and ends immediately. No error messages. It's because "hwnd = GetDesktopWindow()" returns 0.

[idle]

The code does nothing here - it just runs and ends immediately. No error messages. It's because "hwnd = GetDesktopWindow()" returns 0.

Should work on windows 8 10 11
No idea why it's not working for you.

[BarryG]

Specifically, "ProcedureReturn hwndWallpaper" = 0 in the GetDesktopWindow() procedure, which is why it fails.

[idle]

The code does nothing here - it just runs and ends immediately. No error messages. It's because "hwnd = GetDesktopWindow()" returns 0.

What is your OS and maybe its windows defender. It works fine on win11 but it's supposed to work on 8 and 10
simply stating the obvious isn't really helpful, why is it failing? Is it timing out?

[BarryG]

It works fine on win11 but it's supposed to work on 8 and 10

It doesn't work on Win 10 Pro for me. Doesn't work if I disable Defender, either.

My bug report is very specific I would think -> viewtopic.php?p=611506#p611506

I don't know how I can word that any differently that would help any better.

[idle]

It works fine on win11 but it's supposed to work on 8 and 10

It doesn't work on Win 10 Pro for me. Doesn't work if I disable Defender, either.

My bug report is very specific I would think -> viewtopic.php?p=611506#p611506

I don't know how I can word that any differently that would help any better.

Can you see where it fail in GetDesktopWindow 1st "if" 2nd "if" or in EnumWindows.
Maybe it only works in win 11, though it's supposed to work in 8 and 10.

[J. Baker]

Runs just fine here on Windows 10.

[BarryG]

Runs just fine here on Windows 10.

Dammit. Maybe my PC is up the sh*t? People seem to be disagreeing with everything I post lately.

See the Debug comment in this procedure:

Code: Select all

Procedure EnumWindowsProc(hWnd,*Param.INTEGER)
  Protected h, hworker
  h = FindWindowEx_(hWnd, 0, @"SHELLDLL_DefView", 0)
  If h                          
    hworker = FindWindowEx_(0, hWnd, @"WorkerW", 0)
    If hworker
      *Param\i = hworker
      Debug "hworker" ; Never seen, but I assume it should be?
    EndIf
  EndIf
  ProcedureReturn 1
EndProcedure

And for this procedure, the Debug Output is shown below it:

Code: Select all

Procedure.i GetDesktopWindow()
  Protected hwndProgMan
  
  hwndProgMan = FindWindowEx_(0, 0, @"Progman", 0)
  
  If SendMessageTimeout_(hwndProgMan, #WM_NULL, #Null, #Null, #SMTO_ABORTIFHUNG, 1000, #Null)
    Debug "first"
    If SendMessageTimeout_(hwndProgMan, $052C, #Null, #Null, #SMTO_NORMAL, 1000, #Null) <> 0
      Debug "second"
      hwndWallpaper = 0
      EnumWindows_(@EnumWindowsProc(),@hwndWallpaper)
    EndIf
  EndIf
  
  Debug hwndWallpaper ; Shows 0
  ProcedureReturn hwndWallpaper 
EndProcedure 

The Debug Output of GetDesktopWindow():

Code: Select all

first
second
0
first
second
0

I really don't want to re-install Win 10, but maybe I'll have too soon.

[Caronte3D]

Works nice here too (Win10 Pro)

[BarryG]

I tried booting in Safe Mode but it didn't help. I don't get it. There must be a system setting that you guys have either enabled, or I have disabled.

[fryquez]

Does this gives a hWnd?

Code: Select all

Procedure EnumWindowsProc(hWnd, *Param.INTEGER)
  
  Static cWorkerW, cProgman
  If Not cWorkerW
    cWorkerW = RegisterWindowMessage_("WorkerW")
    cProgman = RegisterWindowMessage_("Progman")
  EndIf
  
  If GetClassWord_(hWnd, #GCW_ATOM) = cWorkerW And
     GetClassWord_(GetParent_(hWnd), #GCW_ATOM) = cProgman
    *Param\i = hWnd
    ProcedureReturn 0
  EndIf
  
  ProcedureReturn 1
EndProcedure

Procedure.i GetDesktopWindow()
  
  Protected hwndWallpaper, hShell = GetShellWindow_()
  
  If hShell And SendMessageTimeout_(hShell, #WM_NULL, #Null, #Null, #SMTO_ABORTIFHUNG, 1000, #Null)
    Debug "first"
    If SendMessageTimeout_(hShell, $052C, #Null, #Null, #SMTO_NORMAL, 1000, #Null)
      Debug "second"
      EnumThreadWindows_(GetWindowThreadProcessId_(hShell, 0), @EnumWindowsProc(), @hwndWallpaper)       
    EndIf
  EndIf
  
  Debug Hex(hwndWallpaper)
  ProcedureReturn hwndWallpaper 
EndProcedure 

GetDesktopWindow()

[BarryG]

Does this gives a hWnd?

Nope, just the same Debug output as above ("first", "second", "0").

I'm just updating Win 10 at the moment to see if these updates will fix it: