• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Thay đổi hình nền ngoài desktop (Change WallPaper)

Các mẹo vặt linh tinh khác, không thuộc nhóm nào
Hình đại diện của người dùng
NoBi
Quản trị
Quản trị
Bài viết: 952
Ngày tham gia: T.Ba 18/03/2008 1:22 pm
Đến từ: Sài Gòn
Has thanked: 50 time
Been thanked: 66 time
Liên hệ:

Thay đổi hình nền ngoài desktop (Change WallPaper)

Gửi bàigửi bởi NoBi » T.Tư 03/12/2008 10:02 pm

Thủ thuật: Thay đổi hình nền ngoài desktop (Change WallPaper)
Tác giả: Sưu tầm
Mô tả: Làm thế nào để thay đổi hình nền ngoài desktop (Change WallPaper) ?. Bạn hãy tạo 1 Form mới, thêm vào 1 CommandButton, copy đoạn code sau vào và … enjoy !!!.


Mã: Chọn hết

  1. Option Explicit
  2. ' Các hằng số và hàm phục vụ cho việc thay đổi WallPaper
  3. Private Const SPIF_UPDATEINIFILE = &H1
  4. Private Const SPI_SETDESKWALLPAPER = 20
  5. Private Const SPIF_SENDWININICHANGE = &H2
  6.  
  7. 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
  8.  
  9. 'Phục vụ cho việc ghi giá trị vào Registry
  10. Public Enum REG_TOPLEVEL_KEYS
  11.     HKEY_CLASSES_ROOT = &H80000000
  12.     HKEY_CURRENT_CONFIG = &H80000005
  13.     HKEY_CURRENT_USER = &H80000001
  14.     HKEY_DYN_DATA = &H80000006
  15.     HKEY_LOCAL_MACHINE = &H80000002
  16.     HKEY_PERFORMANCE_DATA = &H80000004
  17.     HKEY_USERS = &H80000003
  18. End Enum
  19.  
  20. Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  21. Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
  22. 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
  23. Private Const REG_SZ = 1
  24.  
  25.  
  26. Public Function ChangeWallPaper(ImageFile As String, Optional Tile As Boolean = True, Optional Center As Boolean = True) As Boolean
  27. Dim lRet As Long
  28. On Error Resume Next
  29.     If Tile Then    'Kieu Tile
  30.         WriteStringToRegistry HKEY_CURRENT_USER, "Control Panel\desktop", "TileWallpaper", "1"
  31.     Else    'Center or Stretch
  32.         WriteStringToRegistry HKEY_CURRENT_USER, "Control Panel\desktop", "TileWallpaper", "0"
  33.         'Center
  34.         If Center Then WriteStringToRegistry HKEY_CURRENT_USER, "Control Panel\desktop", "WallpaperStyle", "0" _
  35.         Else: WriteStringToRegistry HKEY_CURRENT_USER, "Control Panel\desktop", "TileWallpaper", "2"        ' Stretch
  36.     End If
  37.     lRet = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, ImageFile, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
  38.     ChangeWallPaper = lRet <> 0
  39. End Function
  40.  
  41. Private Function WriteStringToRegistry(Hkey As REG_TOPLEVEL_KEYS, strPath As String, strValue As String, strdata As String) As Boolean
  42. Dim bAns As Boolean
  43. On Error GoTo ErrorHandler
  44. Dim keyhand As Long
  45. Dim r As Long
  46.     r = RegCreateKey(Hkey, strPath, keyhand)
  47.     If (r = 0) Then
  48.         r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
  49.         r = RegCloseKey(keyhand)
  50.     End If
  51.     WriteStringToRegistry = (r = 0)
  52.     Exit Function
  53. ErrorHandler:
  54.     WriteStringToRegistry = False
  55.     MsgBox "Thay doi gia tri Registry khong thanh cong", , "Loi :"
  56. End Function
  57.  
  58. Private Sub Command1_Click()
  59.     ChangeWallPaper "C:\Ben Tre.bmp"    ‘Kiểu Tile
  60.     'ChangeWallPaper "C:\Ben Tre.bmp", False    'Kiểu Center
  61.     'ChangeWallPaper "C:\Ben Tre.bmp", False, False 'Kiểu Stretch
  62. End Sub

Với đoạn code trên, các bạn chỉ có thể thay đổi WallPaper bằng những file .bmp mà thôi. Vậy còn đối với mấy file .jpg thì sao ?.
Như các bạn đã biết, WallPaper chỉ hộ trợ những file .bmp mà thôi, còn đối với các file .jpg thì người ta dùng cách sau :
Dùng 1 PictureBox load file .jpg
Dùng lệnh SavePicture() lưu hình trong Picture đó lại thành file .bmp
Vậy là xong, tiếp tục xử lý như bình thường …


:>

tindl88
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 363
Ngày tham gia: T.Bảy 26/04/2008 6:10 pm
Has thanked: 16 time
Been thanked: 10 time

Re: Thay đổi hình nền ngoài desktop (Change WallPaper)

Gửi bàigửi bởi tindl88 » T.Năm 04/12/2008 10:05 am

Bon chen với anh Nobi chút :D
viewtopic.php?f=16&t=4039&p=24762#p24762
cứng nhắc...vớ vẩn

Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4760
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 515 time

Re: Thay đổi hình nền ngoài desktop (Change WallPaper)

Gửi bàigửi bởi truongphu » T.Năm 04/12/2008 5:55 pm

Bài viết Thay đổi hình nền ngoài desktop (Change WallPaper)
1- Function ChangeWallPaper thiếu ghi giá trị ImageFile vào Registry

Mã: Chọn hết

  1. WriteStringToRegistry HKEY_CURRENT_USER, "Control Panel\desktop", "Wallpaper", ImageFile

2- dòng 35 "TileWallpaper", "2" không đúng, phải thay "WallpaperStyle", "2"
3- Mặc dù đã bổ sung, có Restart mà sao Desktop WallPaper cứ trơ trơ nhỉ ? Hay máy tôi có khóa chức năng nào? Nhưng làm bằng tay thì OK!
NoBi chưa test mà dám phục vụ ! :D
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4760
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 515 time

Re: Thay đổi hình nền ngoài desktop (Change WallPaper)

Gửi bàigửi bởi truongphu » T.Năm 04/12/2008 9:51 pm

Mã: Chọn hết

  1. Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
  2. (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
  3. Dim ImagePath As String, WP As Byte
  4.  
  5. Private Sub Command1_Click()
  6. Call RegistryWallPaper("C:\BenTre.bmp", 0)  ' <-- WP: Center = 0, Tile = 1, Stretch = 2
  7. End Sub
  8.  
  9. Private Sub RegistryWallPaper(ImagePath$, WP%)  ' WP: Center = 0, Tile = 1, Stretch = 2
  10. Set objReg = GetObject("winmgmts:\root\default:StdRegProv")
  11. strKeyPath = "Control Panel\Desktop": strValueName = "Wallpaper": strValue = ImageFile
  12. objReg.SetStringValue &H80000001, strKeyPath, strValueName, strValue
  13.  
  14. strValueName = "TileWallpaper":  strValue = "1"
  15.     If WP = 1 Then
  16.         objReg.SetStringValue &H80000001, strKeyPath, strValueName, strValue
  17.     Else: strValue = "0"
  18.         objReg.SetStringValue &H80000001, strKeyPath, strValueName, strValue
  19.             strValueName = "WallpaperStyle": strValue = "0"
  20.             If WP = 0 Then objReg.SetStringValue &H80000001, strKeyPath, strValueName, strValue
  21.             If WP = 2 Then
  22.                 strValue = "2"
  23.                 objReg.SetStringValue &H80000001, strKeyPath, strValueName, strValue
  24.             End If
  25.     End If
  26. Call SystemParametersInfo(20, 0, ImagePath, 1)
  27. End Sub

Có tác dụng tức thì.
Thực ra thì đăng ký strValueName = "Wallpaper": strValue = ImageFile không quan trọng, sau khi tắt máy windows sẽ lưu giá trị nầy nên có thể bỏ
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

Hình đại diện của người dùng
NoBi
Quản trị
Quản trị
Bài viết: 952
Ngày tham gia: T.Ba 18/03/2008 1:22 pm
Đến từ: Sài Gòn
Has thanked: 50 time
Been thanked: 66 time
Liên hệ:

Re: Thay đổi hình nền ngoài desktop (Change WallPaper)

Gửi bàigửi bởi NoBi » T.Sáu 05/12/2008 12:32 pm

Bài này mình lấy từ forum cũ qua (đã được kiểm duyệt bên đó) nên kg có test lại. Để xem lại nó sai chổ nào. :D
:>

Hình đại diện của người dùng
NoBi
Quản trị
Quản trị
Bài viết: 952
Ngày tham gia: T.Ba 18/03/2008 1:22 pm
Đến từ: Sài Gòn
Has thanked: 50 time
Been thanked: 66 time
Liên hệ:

Re: Thay đổi hình nền ngoài desktop (Change WallPaper)

Gửi bàigửi bởi NoBi » T.Bảy 10/01/2009 11:19 am

Sao em copy code bài viết đầu tiên vào form chạy bình thường mà bác truongphu?. Em mới test lại trên windows XP chạy ok nè. Kỳ vậy ta?!.
:>


Quay về “[VB] Mẹo vặt khác”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.0 khách