PureBasic Forums - English

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 

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

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 

Code: Select all

first
second
0
first
second
0

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