Các chiêu thức trong lập trình Thay đổi hình nền cho Desktophome

Thay đổi hình nền cho Desktop home Xuất xứ : www.caulacbovb.com Binh khí sử dụng : Một CommandButton Đoạn mã : Option Explicit ‘ Các hằng số và hàm phục vụ cho việc thay đổi WallPaper 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 ‘Phục vụ cho việc ghi giá trị vào Registry 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, Optional Tile As Boolean = True, Optional Center As Boolean = True) As Boolean Dim lRet As Long On Error Resume Next If Tile Then 'Kieu Tile WriteStringToRegistry HKEY_CURRENT_USER, "Control Panel\desktop", "TileWallpaper", "1" Else 'Center or Stretch WriteStringToRegistry HKEY_CURRENT_USER, "Control Panel\desktop", "TileWallpaper", "0" 'Center If Center Then WriteStringToRegistry HKEY_CURRENT_USER, "Control Panel\desktop", "WallpaperStyle", "0" _ Else: WriteStringToRegistry HKEY_CURRENT_USER, "Control Panel\desktop", "TileWallpaper", "2" ' Stretch End If lRet = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, ImageFile, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE) ChangeWallPaper = lRet <> 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 MsgBox "Thay doi gia tri Registry khong thanh cong", , "Loi :" End Function Private Sub Command1_Click() ‘ Load file ảnh cần thiết ChangeWallPaper "C:\Ben Tre.bmp" ‘Kiểu Tile ‘ChangeWallPaper "C:\Ben Tre.bmp", False ‘Kiểu Center ‘ChangeWallPaper "C:\Ben Tre.bmp", False, False ‘Kiểu Stretch End Sub . Thay đổi hình nền cho Desktop home Xuất xứ : www.caulacbovb.com Binh khí sử dụng : Một CommandButton Đoạn mã : Option Explicit ‘ Các hằng số. CommandButton Đoạn mã : Option Explicit ‘ Các hằng số và hàm phục vụ cho việc thay đổi WallPaper Private Const SPIF_UPDATEINIFILE = &H1 Private Const