更换墙纸几乎都是同一个API函数SystemParametersInfo和同一段代码,国外站点提供的免费代码也是如此。从VB4.0开始就这样。这段码是: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
Const SPI_SETDESKWALLPAPER = 20
Const SPIF_SENDWININICHANGE = &H2
Const SPIF_UPDATEINIFILE = &H1Private Sub Form_Load()
  ChangeWP = SystemParametersInfo(SPI_SETDESKWALLPAPER, 
         0, "Path+BmpFile", 0)
End Sub   使用这个例程确实能够切换墙纸,但存在以下问题:  1、用鼠标右键点击桌面,会看到【背景】→【墙纸】里面的文件名是空的。  2、重新启动后桌面墙纸消失。  3、没告诉您怎么切换"居中"或"平铺"。  怎么解决这些问题呢?  1、Windows的墙纸必须以BMP格式的文件存放在Windows目录下面,如果您的图片不在该目录或不是BMP文件,那么就会出现第一个问题。因此必须把您的图片转换成BMP文件并复制到Windows目录下面。  2、要使重新启动后需要在注册表里面修改相应的键值,具体位置是 HKEY_CURRENT_USER\Control Panel\desktop中的Wallpaper键,让它的键值等于您的全路径文件名。  3、在更换墙纸以前首先设置是否"居中",需要修改注册表中HKEY_CURRENT_USER\Control Panel\desktop中的TileWallpaper键,键值"0"表示"居中","1"表示"平铺"。  本例把一个JPG格式的图片成功地设置为墙纸,全部代码如下: 
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As LongPrivate Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As LongConst SPI_SETDESKWALLPAPER = 20
Const SPIF_SENDWININICHANGE = &H2
Const SPIF_UPDATEINIFILE = &H1
Const REG_SZ As Long = 1
Const HKEY_CURRENT_USER = &H80000001Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As LongPrivate Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As LongPrivate Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As LongPrivate Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As LongPrivate Sub SetKeyValue(sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long, lPredefinedKey As Long) lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, 
             KEY_ALL_ACCESS, hKey)
 lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
 RegCloseKey (hKey)
End SubPrivate Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
 Dim lValue As Long
 Dim sValue As String
 Select Case lType
  Case REG_SZ
     sValue = vValue & Chr$(0)
     SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, 
            sValue, Len(sValue))
  Case REG_DWORD, REG_BINARY
     lValue = vValue
     SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, 
            lType, lValue, 4)
 End Select
End FunctionPrivate Sub Form_Load()
'取得windows目录
 Dim Path As String, strSave As String
 strSave = String(50, Chr$(0))
 Path = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave)))
 '转换图片并保存到Windows目录下面
 Image1.Picture = LoadPicture(App.Path & "\MyFlower.Jpg")
 SavePicture Image1, Path & "\MyFlower.bmp"
 Dim aa As String
 '写入注册表
 '设定居中
 SetKeyValue "Control Panel\desktop", "TileWallpaper", 
        "0", REG_SZ, HKEY_CURRENT_USER
 '设定平铺
 ' SetKeyValue "Control Panel\desktop", 
         "TileWallpaper", "1", REG_SZ, HKEY_CURRENT_USER
 '更换墙纸
 aa = Path & "\MyFlower.bmp"
 ChangeWP = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, aa, 0)
 '在注册表中记录图片位置
 SetKeyValue "Control Panel\desktop", "Wallpaper", aa, 
        REG_SZ, HKEY_CURRENT_USER
End Sub   使用本例要注意:必须先设置是否"居中",然后再更换墙纸。