Basic Univers


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