2013-06-19 07:49

'=======================================================
' Type Objet
' Classe QDesktop version 1.0
'=======================================================
     DECLARE FUNCTION SetActiveDesktop LIB "USER32" ALIAS "SetActiveWindow" (hWnd AS INTEGER) AS INTEGER
     DECLARE FUNCTION GetDCDesktop LIB "user32" ALIAS "GetDC" (hWnd AS INTEGER) AS INTEGER
     DECLARE FUNCTION ReleaseDCDesktop LIB "user32" ALIAS "ReleaseDC" (hWnd AS INTEGER,hDC AS INTEGER) AS INTEGER
     DECLARE FUNCTION BitBltDesktop LIB "gdi32" ALIAS "BitBlt" (hDC AS INTEGER,nXDest AS INTEGER,nYDest AS INTEGER,nWidth AS INTEGER,nHeight AS INTEGER,hdcSrc AS INTEGER,nXSrc AS INTEGER,nYSrc AS INTEGER,dwRop AS INTEGER) AS INTEGER
     DECLARE FUNCTION PaintDesktop LIB "user32" ALIAS "PaintDesktop" (HDC AS INTEGER) AS INTEGER
     DECLARE FUNCTION GetPixelDesktop LIB "gdi32" ALIAS "GetPixel" (hdc AS LONG,x AS LONG,y AS LONG) AS LONG
     DECLARE FUNCTION SystemParametersInfo LIB "user32" ALIAS "SystemParametersInfoA" (uAction AS LONG,uParam AS LONG,lpvParam AS LONG,fuWinIni AS LONG) AS LONG

' SystemParametersInfo flags
     CONST SPIF_UPDATEINIFILE=&H1
     CONST SPIF_SENDWININICHANGE=&H2
     CONST SPI_SETDESKWALLPAPER=20

     TYPE QDesktop EXTENDS QOBJECT
  '===============================================
  ' Method copy desktop
  '===============================================
      SUB Copy(handle AS LONG,x AS INTEGER,y AS INTEGER,width AS INTEGER,height AS INTEGER)
       DIM DC AS INTEGER
       DIM nWidth AS INTEGER
       DIM nHeight AS INTEGER

    'SetActiveDesktop(0)
       DC=GetDCDesktop(0)
       IF width>Screen.Width THEN
        nWidth=Screen.Width
       ELSE
        nWidth=width
       END IF
       IF height>Screen.Height THEN
        nHeight=Screen.Height
       ELSE
        nHeight=height
       END IF
       BitBltDesktop(handle,x,y,nWidth,nHeight,DC,0,0,&HCC0020)
       ReleaseDCDesktop(0,DC)
      END SUB

  '===============================================
  ' Method copy wallpaper
  '===============================================
      SUB CopyWallPaper(handle AS LONG)
       PaintDesktop(handle)
      END SUB

  '===============================================
  ' Method return color pixel
  '===============================================
      FUNCTION GetPixel(x AS INTEGER,y AS INTEGER) AS LONG
       DIM DC AS INTEGER
       DIM COLOR AS LONG

       DC=GetDCDesktop(0)
       COLOR=GetPixelDesktop(DC,x,y)
       ReleaseDCDesktop(0,DC)
       result=COLOR
      END FUNCTION

  '===============================================
  ' Method change wallpaper
  '===============================================
      SUB ChangeWallPaper(FileName AS STRING)
       DIM File AS STRING
       DIM Flag AS LONG

       IF FileName<>"" THEN
        File=FileName
        Flag=SPIF_UPDATEINIFILE+SPIF_SENDWININICHANGE
        SystemParametersInfo(SPI_SETDESKWALLPAPER,0,VARPTR(File),Flag)
       END IF
      END SUB
     END TYPE

2013-06-19 07:49