|
在客户运行您的应用程序的时候自动更换墙纸，显然是广告宣传的一个好机会。但无论是 MSDN还是网络上的免费资源代码，更换墙纸几乎都是同一个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 = &H1 Private 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 Long 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 = &H1 Const REG_SZ As Long = 1 Const HKEY_CURRENT_USER = &H80000001 Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private 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 Long Private 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 Long Private 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 Long Private 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 Sub Private 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 Function Private 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 使用本例要注意：必须先设置是否"居中"，然后再更换墙纸。本例在Windows95+VB6下调试通 过。 | 