Private Const SPIF_UPDATEINIFILE = &H1
Private Const SPI_SETDESKWALLPAPER = 20
Private Const SPIF_SENDWININICHANGE = &H2
 
Private Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
 
 
Public Enum REG_TOPLEVEL_KEYS
 HKEY_CLASSES_ROOT = &H80000000
 HKEY_CURRENT_CONFIG = &H80000005
 HKEY_CURRENT_USER = &H80000001
 HKEY_DYN_DATA = &H80000006
 HKEY_LOCAL_MACHINE = &H80000002
 HKEY_PERFORMANCE_DATA = &H80000004
 HKEY_USERS = &H80000003
End Enum
 
 
Private Declare Function RegCreateKey Lib _
   "advapi32.dll" Alias "RegCreateKeyA" _
   (ByVal Hkey As Long, ByVal lpSubKey As _
   String, phkResult As Long) As Long
 
Private Declare Function RegCloseKey Lib _
   "advapi32.dll" (ByVal Hkey As Long) As Long
 
Private Declare Function RegSetValueEx Lib _
   "advapi32.dll" Alias "RegSetValueExA" _
   (ByVal Hkey As Long, ByVal _
   lpValueName As String, ByVal _
   Reserved As Long, ByVal dwType _
   As Long, lpData As Any, ByVal _
   cbData As Long) As Long
 
Private Const REG_SZ = 1
 
 
Public Function ChangeWallPaper(ImageFile As String, Tile As Boolean)
 
'Pass Full Path of .BMP to this function
'Returns true if successful, false otherwise
'If you want to tile, set Tile to True
 
Dim lRet As Long
On Error Resume Next
 
If Tile Then WriteStringToRegistry HKEY_CURRENT_USER, _
  "Control Panel\desktop", "TileWallpaper", "1"
 
lRet = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, ImageFile, _
   SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
ChangeWallPaper = lRet <> 0 And Err.LastDllError = 0
End Function
 
Private Function WriteStringToRegistry(Hkey As _
  REG_TOPLEVEL_KEYS, strPath As String, strValue As String, _
  strdata As String) As Boolean
 
 
Dim bAns As Boolean
 
On Error GoTo ErrorHandler
   Dim keyhand As Long
   Dim r As Long
   r = RegCreateKey(Hkey, strPath, keyhand)
   If r = 0 Then
		r = RegSetValueEx(keyhand, strValue, 0, _
		   REG_SZ, ByVal strdata, Len(strdata))
		r = RegCloseKey(keyhand)
	End If
 
   WriteStringToRegistry = (r = 0)
 
Exit Function
 
ErrorHandler:
	WriteStringToRegistry = False
	Exit Function
 
End Function
 
 
 
 
Private Sub Form_Load()
Dim x, sourcef
sourcef = "c:\tuimagen.bmp" 'PATH DE LA IMAGEN PARA EL FONDO DE PANTALLA
x = ChangeWallPaper(sourcef, False)
Unload Me
End Sub
 

'general declaration in the module or change scope to Private if you declare this in the form
Option Explicit
 
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
                        (ByVal uAction As Long, ByVal uParam As Long, _
                         ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
 
Public Const SPI_SETDESKWALLPAPER = 20
Public Const SPIF_SENDWININICHANGE = &H2
Public Const SPIF_UPDATEINIFILE = &H1
 
'typical usage
Dim strImagePath As String
 
strImagePath = "c:\tuimagen.bmp"
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, strImagePath, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)