|
杜運(yùn)慶
在客戶(hù)運(yùn)行您的應(yīng)用程序的時(shí)候自動(dòng)更換墻紙，顯然是廣告宣傳的一個(gè)好機(jī)會(huì)。但無(wú)論是MSDN還是網(wǎng)絡(luò)上的免費(fèi)資源代碼，更換墻紙幾乎都是同一個(gè)API函數(shù)SystemParametersInfo和同一段代碼，國(guó)外站點(diǎn)提供的免費(fèi)代碼也是如此。從VB4.0開(kāi)始就這樣。這段代碼是：
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
使用這個(gè)例程確實(shí)能夠切換墻紙，但存在以下問(wèn)題：
1、用鼠標(biāo)右鍵點(diǎn)擊桌面，會(huì)看到【背景】→【墻紙】里面的文件名是空的。
2、重新啟動(dòng)后桌面墻紙消失。
3、沒(méi)告訴您怎么切換"居中"或"平鋪"。
怎么解決這些問(wèn)題呢？
1、Windows的墻紙必須以BMP格式的文件存放在Windows目錄下面，如果您的圖片不在該目錄或不是BMP文件，那么就會(huì)出現(xiàn)第一個(gè)問(wèn)題。因此必須把您的圖片轉(zhuǎn)換成BMP文件并復(fù)制到Windows目錄下面。
2、要使重新啟動(dòng)后需要在注冊(cè)表里面修改相應(yīng)的鍵值，具體位置是 HKEY_CURRENT_USER\Control Panel\desktop中的Wallpaper鍵，讓它的鍵值等于您的全路徑文件名。
3、在更換墻紙以前首先設(shè)置是否"居中"，需要修改注冊(cè)表中HKEY_CURRENT_USER\Control Panel\desktop中的TileWallpaper鍵，鍵值"0"表示"居中"，"1"表示"平鋪"。
本例把一個(gè)JPG格式的圖片成功地設(shè)置為墻紙，全部代碼如下：
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)))
'轉(zhuǎn)換圖片并保存到Windows目錄下面
Image1.Picture = LoadPicture(App.Path & "\MyFlower.Jpg")
SavePicture Image1, Path & "\MyFlower.bmp"
Dim aa As String
'寫(xiě)入注冊(cè)表
'設(shè)定居中
SetKeyValue "Control Panel\desktop", "TileWallpaper",
"0", REG_SZ, HKEY_CURRENT_USER
'設(shè)定平鋪
' SetKeyValue "Control Panel\desktop",
"TileWallpaper", "1", REG_SZ, HKEY_CURRENT_USER
'更換墻紙
aa = Path & "\MyFlower.bmp"
ChangeWP = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, aa, 0)
'在注冊(cè)表中記錄圖片位置
SetKeyValue "Control Panel\desktop", "Wallpaper", aa,
REG_SZ, HKEY_CURRENT_USER
End Sub
使用本例要注意：必須先設(shè)置是否"居中"，然后再更換墻紙。本例在Windows95+VB6下調(diào)試通過(guò)。
|
