|
杜運慶
在客戶運行您的應用程序的時候自動更換墻紙，顯然是廣告宣傳的一個好機會。但無論是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下調試通過。
|
