PureBasic

Code : Tout sélectionner

Procedure SetWallpaper(FileName.s, style.s) ; style = 0 : centrer
  RegOpenKeyEx_ ( #HKEY_CURRENT_USER , "Control Panel\Desktop\" , #Null , #KEY_ALL_ACCESS , @hKey)
  RegSetValueEx_ (hKey, "WallpaperStyle" , #Null , #REG_SZ , @style, Len (style) + 1 )
  RegSetValueEx_ (hKey, "TileWallpaper" , #Null , #REG_SZ , @style, Len (style) + 1 )
  SystemParametersInfo_ ( #SPI_SETDESKWALLPAPER , 0, FileName, #SPIF_UPDATEINIFILE | #SPIF_SENDWININICHANGE )
EndProcedure

WPFileName.s = OpenFileRequester ( "Choix de l'image" , "*.*" , "All Files (*.*)|*.*" , 0, 0)
Debug GetFileType(WPFileName)

If GetFileType(WPFileName)<>"Image Wondows Bitmap"
  UseJPEGImageDecoder() : UsePNGImageDecoder() : UseTGAImageDecoder() : UseTIFFImageDecoder()
  CreateImage(1,1000,800) : LoadImage(1,WPFileName) : SaveImage(1,"c:\Windows\FondActuel.bmp",#PB_ImagePlugin_BMP)
  WPFileName.s = "c:\Windows\FondActuel.bmp" 
EndIf

If WPFileName <> ""
  SetWallpaper(WPFileName, "2" )
EndIf

Code : Tout sélectionner

Procedure SetWallpaper(FileName.s, Style.s)    ; style = 0 : centrer / style = 2 : étirer 
    RegOpenKeyEx_ ( #HKEY_CURRENT_USER , "Control Panel\Desktop\" , #Null , #KEY_ALL_ACCESS , @hKey)
    RegSetValueEx_ (hKey, "WallpaperStyle" , #Null , #REG_SZ , @Style, Len (Style) + 1 )
  Style = "0" 
    RegSetValueEx_ (hKey, "TileWallpaper" , #Null , #REG_SZ , @Style, Len (Style) + 1 )
    SystemParametersInfo_ ( #SPI_SETDESKWALLPAPER , 0, FileName, #SPIF_UPDATEINIFILE | #SPIF_SENDWININICHANGE )
EndProcedure 

cheminapp$=GetCurrentDirectory():cheminapp2$=cheminapp$+"outils\"
FichierParDefaut$ = cheminapp$+"dt_image.bmp"   ; Répertoire et fichier par défaut qui seront affichés
  Filtre$ = "Image (*.bmp)|*.bmp"
  Filtre  = 0    ; utiliser  par défaut le premier des trois filtres possibles
 WPFileName.s = OpenFileRequester("Choisissez une image BMP à charger", FichierParDefaut$, Filtre$, Filtre)

If WPFileName <> "" 
  SetWallpaper(WPFileName, "2" )
EndIf 

Code : Tout sélectionner

WallPaper.s="????"
;Exemple : WallPaper.s="D:\Images\Fonds d'écrans\073.jpg"
SystemParametersInfo_ (#SPI_SETDESKWALLPAPER, 0, WallPaper, 0)

Code : Tout sélectionner

UseJPEGImageDecoder() 


Enumeration
  #WIN
  #CANVAS
  #image
EndEnumeration



Procedure.c GetBarHeight()
  
  ; +--------------------------------------------------------------------------+
  ; | Code original de GallyHC modifié par Ar-S                                 |
  ; +--------------------------------------------------------------------------+
  
  #ABM_GETSTATE       = 4
  #ABM_GETTASKBARPOS  = 5
  
  
  Structure lNXY
    width.l
    height.l
  EndStructure
  
  Define Barre.lNXY
  Define Cadre.RECT
  Define BarreData.APPBARDATA
  
  SHAppBarMessage_(#ABM_GETTASKBARPOS, BarreData)
  SHAppBarMessage_(#ABM_GETSTATE, BarreData)
  Cadre\left   = BarreData\rc\left
  Cadre\right  = BarreData\rc\right
  Cadre\top    = BarreData\rc\top
  Cadre\bottom = BarreData\rc\bottom
  Barre\width  = Cadre\right  - Cadre\left
  Barre\height = Cadre\bottom - Cadre\top
  
  
  If Cadre\left < 1 And Cadre\top > 0 And (Barre\width > Barre\height)
    BarPos = 1 ; bas
  EndIf
  If Cadre\left < 1 And Cadre\top < 1 And (Barre\width < Barre\height)
    BarPos = 2 ; gauche
  EndIf
  If Cadre\left > 1 And Cadre\top < 1 And (Barre\width < Barre\height)
    BarPos = 3 ; haut
  EndIf
  If Cadre\left < 1 And Cadre\top < 1 And (Barre\width > Barre\height)
    BarPos = 4 ; haut
  EndIf
  
  If BarPos = 1
    HauteurBarre = Cadre\bottom - Cadre\top
    ProcedureReturn HauteurBarre
  Else
    ProcedureReturn 0
  EndIf
  
EndProcedure




Ecran_X = GetSystemMetrics_(0)
Ecran_Y = GetSystemMetrics_(1)  - GetBarHeight()

If OpenWindow(#WIN, 0, 0, Ecran_X, Ecran_Y, "WALLPAPER", #PB_Window_BorderLess)

  CanvasGadget(#CANVAS, 0, 0, Ecran_X, Ecran_Y,#PB_Canvas_DrawFocus|#PB_Canvas_ClipMouse)
  
  FichierImage$ = "E:\MULTIMEDIA\PUREBASIC\4.40\CropCrop\1700x1200.jpg"
  
  Image = LoadImage(#image, FichierImage$)
  If Image

    Limg = ImageHeight(#image)
    Himg = ImageHeight(#image)
    
    ; LSI
    If  Himg > Ecran_Y Or Limg > Ecran_X
      If Ecran_X * Himg <= Limg * Ecran_Y
        newL = Ecran_X
        newH = Himg * Ecran_X / Limg
      
      Else
        newL = Limg * Ecran_Y / Himg
        newH = Himg * Ecran_Y
      
      EndIf
    EndIf

    StartDrawing(CanvasOutput(#CANVAS))
      DrawImage(ImageID(#image), 0, 0)
    StopDrawing()
    
  Else
    MessageRequester( " Erreur ", " image introuvable " , #MB_OK  ) ;-TEST
    End
  EndIf
  
  
  
  

Repeat
  Select WaitWindowEvent()
      ; ///////////////////
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #CANVAS
          Select EventType()
            Case #PB_EventType_LeftButtonDown, #PB_EventType_RightClick
              FreeImage(#image)
              End
          EndSelect
      EndSelect
      
    Case #PB_Event_CloseWindow
      Select EventWindow()
        Case #WIN
          CloseWindow(#WIN)
          Break
      EndSelect
  EndSelect
ForEver


EndIf