La même chose avec possibilité de choisir une image jpeg, bmp,..
ProcedureDLL.s GetUserProfileDirectory() ; Retourne l'adresse du répertoire utilisateur
OpenProcessToken_ ( GetCurrentProcess_ (), $08, @token)
Length.l = 512
directory$ = Space (Length)
GetUserProfileDirectory_ (token, directory$, @Length)
ProcedureReturn Left (directory$, Length) + "\"
EndProcedure
ProcedureDLL.s GetWindowsDirectory_BIS() ; Retourne l'adresse de Windows
windir$ = Space (255) : GetWindowsDirectory_ ( @windir$, 255) : If Right (windir$, 1) <> "\" : windir$ + "\" : EndIf
ProcedureReturn windir$
EndProcedure
ProcedureDLL SetWallpaper(FileName.s, Image, mode.l, BackgroundColor.l) ; mode=1 Etirer, 2 Centrer, 3 Centrer et agrandir, 4 Mosaïque, 5 Mosaïque et agrandi (si FileName="" , Image sera pris en compte et inversement)
; mode=1 Etirer
; mode=2 Centrer
; mode=3 Centrer et agrandissement proportionnel
; mode=4 Mosaïque
; mode=5 Mosaïque et agrandissement proportionel
If FileName
UseJPEGImageDecoder ()
; UseEC_OLEImageDecoder()
UsePNGImageDecoder ()
UseTGAImageDecoder ()
UseTIFFImageDecoder ()
idi = LoadImage ( #PB_Any , FileName)
ElseIf Image
idi = Image
EndIf
If IsImage (idi)
id = ImageID (idi)
largimag = ImageWidth (idi)
hautimag = ImageHeight (idi)
dx = GetSystemMetrics_ ( #SM_CXSCREEN )
dy = GetSystemMetrics_ ( #SM_CYSCREEN )
lon = Len ( GetExtensionPart (FileName))
If IsAdmin() = 1
If OSVersion () = #PB_OS_Windows_XP Or OSVersion () = #PB_OS_Windows_2000
photo.s = GetWindowsDirectory_BIS() + "Web\Wallpaper\Fond d'écran.bmp"
Else
photo.s = GetWindowsDirectory_BIS() + "Fond d'écran.bmp"
EndIf
Else
photo.s = GetUserProfileDirectory() + "Fond d'écran.bmp"
EndIf
If mode = 1
ResizeImage (idi, dx, dy)
SaveImage (idi, photo)
ElseIf mode = 2
idi2 = CreateImage ( #PB_Any , dx, dy)
StartDrawing ( ImageOutput (idi2))
Box (0, 0, dx, dy, BackgroundColor)
DrawImage (Id, (dx - largimag) / 2, (dy - hautimag) / 2)
StopDrawing ()
SaveImage (idi2, photo)
ElseIf mode = 3
idi2 = CreateImage ( #PB_Any , dx, dy)
StartDrawing ( ImageOutput (idi2))
Box (0, 0, dx, dy, BackgroundColor)
clarg.f = dx / largimag
chaut.f = dy / hautimag
If clarg > chaut
DrawImage (Id, (dx - Round (chaut * largimag, 0)) / 2, 0, Round (chaut * largimag, 0), dy)
ElseIf clarg < chaut
DrawImage (Id, 0, (dy - Round (clarg * hautimag, 0)) / 2, dx, Round (clarg * hautimag, 0))
Else
DrawImage (id, 0, 0, dx, dy)
EndIf
StopDrawing ()
SaveImage (idi2, photo)
FreeImage (idi2)
ElseIf mode = 4
idi2 = CreateImage ( #PB_Any , dx, dy)
StartDrawing ( ImageOutput (idi2))
Box (0, 0, dx, dy, BackgroundColor)
nc = Round (dx / largimag, 1)
nl = Round (dy / hautimag, 1)
For a = 0 To nc - 1
For b = 0 To nl - 1
DrawImage (id, a * largimag, b * hautimag)
Next
Next
StopDrawing ()
SaveImage (idi2, photo)
FreeImage (idi2)
ElseIf mode = 5
idi2 = CreateImage ( #PB_Any , dx, dy)
StartDrawing ( ImageOutput (idi2))
Box (0, 0, dx, dy, BackgroundColor)
clarg.f = dx / largimag
chaut.f = dy / hautimag
If clarg > chaut
width = Round (chaut * largimag, 0)
height = dy
ElseIf clarg < chaut
width = dx
height = Round (clarg * hautimag, 0)
Else
width = dx
height = dy
EndIf
nc = Round (dx / width, 1)
nl = Round (dy / height, 1)
For a = 0 To nc - 1
For b = 0 To nl - 1
DrawImage (id, a * width, b * Height, width, height)
Next
Next
StopDrawing ()
SaveImage (idi2, photo)
FreeImage (idi2)
EndIf
If FileName
FreeImage (idi)
EndIf
ProcedureReturn SystemParametersInfo_ ( #SPI_SETDESKWALLPAPER , 0, photo, #SPIF_UPDATEINIFILE | #SPIF_SENDWININICHANGE )
EndIf
EndProcedure
