• 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

Set hình nền desktop [Hổ trợ tất cả định dạng ảnh]

Các thủ thuật về hệ thống, thư mục, tập tin và mạng
Hình đại diện của người dùng
T7
Thành viên danh dự
Thành viên danh dự
Bài viết: 415
Ngày tham gia: T.Năm 24/05/2007 8:19 pm
Đến từ: Long Xuyên - An Giang
Been thanked: 12 time
Liên hệ:

Set hình nền desktop [Hổ trợ tất cả định dạng ảnh]

Gửi bàigửi bởi T7 » T.Năm 29/05/2008 3:04 pm

Thủ thuật: Set một ảnh làm hình nền
Tác giả: đây">Sưu tầm. Xem bản góc tại đây
Mô tả: Việc chọn một ảnh làm hình nền cho máy thì có lẽ nhiều người cũng đã biết, nhưng có điều cách đó chỉ được với những ảnh bmp thôi, còn với ảnh jpg, png, gif,... - một định dạng ảnh vô cùng thông dụng và gọn nhẹ, thì chỉ có cách thực hiện lệnh chuyển ngược lại ảnh bmp thì mới có thể sử dụng được. Điều này hơi bất tiện nên em xin bày cho mọi người cách khác để thay đổi hình nền cho desktop cực kì nhanh gọn, đó là tác động trực tiếp lên active desktop :D . Em đã thử test với mọi định dạng ảnh, kể cả htm nó điều có thể chạy được luôn :>


Mã: Chọn hết

  1. 'Bỏ vô module
  2. Private Declare Function IIDFromString Lib "ole32" (ByVal lpszIID As Long, iid As Any) As Long
  3. Private Declare Function CoCreateInstance Lib "ole32" (rclsid As Any, ByVal pUnkOuter As Long, ByVal dwClsContext As Long, riid As Any, ByVal ppv As Long) As Long
  4. Private Declare Function CallWindowProcA Lib "user32" (ByVal addr As Long, ByVal p1 As Long, ByVal p2 As Long, ByVal p3 As Long, ByVal p4 As Long) As Long
  5. Private Declare Sub RtlMoveMemory Lib "kernel32" (pDst As Any, pSrc As Any, ByVal dlen As Long)
  6.  
  7. Private Const CLSCTX_INPROC_SERVER  As Long = 1&
  8. Private Const CLSID_ActiveDesktop   As String = "{75048700-EF1F-11D0-9888-006097DEACF9}"
  9. Private Const IID_ActiveDesktop     As String = "{F490EB00-1240-11D1-9888-006097DEACF9}"
  10.  
  11. Private Type GUID
  12.   data1                   As Long
  13.   data2                   As Integer
  14.   data3                   As Integer
  15.   data4(7)                As Byte
  16. End Type
  17.  
  18. Private Type IActiveDesktop
  19.   QueryInterface          As Long
  20.   AddRef                  As Long
  21.   Release                 As Long
  22.   ApplyChanges            As Long
  23.   GetWallpaper            As Long
  24.   SetWallpaper            As Long
  25.   GetWallpaperOptions     As Long
  26.   SetWallpaperOptions     As Long
  27.   GetPattern              As Long
  28.   SetPattern              As Long
  29.   GetDesktopItemOptions   As Long
  30.   SetDesktopItemOptions   As Long
  31.   AddDesktopItem          As Long
  32.   AddDesktopItemWithUI    As Long
  33.   ModifyDesktopItem       As Long
  34.   RemoveDesktopItem       As Long
  35.   GetDesktopItemCount     As Long
  36.   GetDesktopItem          As Long
  37.   GetDesktopItemByID      As Long
  38.   GenerateDesktopItemHtml As Long
  39.   AddUrl                  As Long
  40.   GetDesktopItemBySource  As Long
  41. End Type
  42.  
  43. Private Enum AD_APPLY
  44.   AD_APPLY_SAVE = &H1
  45.   AD_APPLY_HTMLGEN = &H2
  46.   AD_APPLY_REFRESH = &H4
  47.   AD_APPLY_ALL = &H7
  48.   AD_APPLY_FORCE = &H8
  49.   AD_APPLY_BUFFERED_REFRESH = &H10
  50.   AD_APPLY_DYNAMICREFRESH = &H20
  51. End Enum
  52.  
  53. Public Function SetWallpaper(ByVal strFile As String) As Boolean
  54.  
  55.     Dim vtbl            As IActiveDesktop
  56.     Dim vtblptr         As Long
  57.  
  58.     Dim classid         As GUID
  59.     Dim iid             As GUID
  60.  
  61.     Dim obj             As Long
  62.     Dim hRes            As Long
  63.  
  64.     hRes = IIDFromString(StrPtr(CLSID_ActiveDesktop), classid)
  65.     If hRes <> 0 Then
  66.         Exit Function
  67.     End If
  68.  
  69.     hRes = IIDFromString(StrPtr(IID_ActiveDesktop), iid)
  70.     If hRes <> 0 Then
  71.         Exit Function
  72.     End If
  73.  
  74.     hRes = CoCreateInstance(classid, 0, CLSCTX_INPROC_SERVER, iid, VarPtr(obj))
  75.     If hRes <> 0 Then
  76.         Exit Function
  77.     End If
  78.  
  79.     RtlMoveMemory vtblptr, ByVal obj, 4
  80.     RtlMoveMemory vtbl, ByVal vtblptr, Len(vtbl)
  81.  
  82.     hRes = CallPointer(vtbl.SetWallpaper, obj, StrPtr(strFile), 0)
  83.     If hRes = 0 Then
  84.         SetWallpaper = True
  85.     End If
  86.     hRes = CallPointer(vtbl.ApplyChanges, obj, AD_APPLY_ALL Or AD_APPLY_FORCE)
  87.     CallPointer vtbl.Release, obj
  88. End Function
  89.  
  90. Private Function CallPointer(ByVal fnc As Long, ParamArray params()) As Long
  91.  
  92.   Dim btASM(&HEC00& - 1)  As Byte
  93.   Dim pASM                As Long
  94.   Dim i                   As Integer
  95.  
  96.   pASM = VarPtr(btASM(0))
  97.  
  98.   AddByte pASM, &H58
  99.   AddByte pASM, &H59
  100.   AddByte pASM, &H59
  101.   AddByte pASM, &H59
  102.   AddByte pASM, &H59
  103.   AddByte pASM, &H50
  104.  
  105.   For i = UBound(params) To 0 Step -1
  106.     AddPush pASM, CLng(params(i))
  107.   Next
  108.  
  109.   AddCall pASM, fnc
  110.   AddByte pASM, &HC3
  111.  
  112.   CallPointer = CallWindowProcA(VarPtr(btASM(0)), 0, 0, 0, 0)
  113. End Function
  114.  
  115. Private Sub AddPush(pASM As Long, lng As Long)
  116.   AddByte pASM, &H68
  117.   AddLong pASM, lng
  118. End Sub
  119.  
  120. Private Sub AddCall(pASM As Long, addr As Long)
  121.   AddByte pASM, &HE8
  122.   AddLong pASM, addr - pASM - 4
  123. End Sub
  124.  
  125. Private Sub AddLong(pASM As Long, lng As Long)
  126.   RtlMoveMemory ByVal pASM, lng, 4
  127.   pASM = pASM + 4
  128. End Sub
  129.  
  130. Private Sub AddByte(pASM As Long, bt As Byte)
  131.   RtlMoveMemory ByVal pASM, bt, 1
  132.   pASM = pASM + 1
  133. End Sub


Cách dùng:

Mã: Chọn hết

  1. SetWallpaper "C:\WINDOWS\Web\Wallpaper\Ascent.jpg"


nếu giá trị hàm trả về True tức là thành công, còn nếu là False thì... ;))
Sửa lần cuối bởi T7 vào ngày T.Năm 29/05/2008 7:16 pm với 1 lần sửa.


While (i <= you) i++;

Hình đại diện của người dùng
tieurongtien
Thành viên năng nổ
Thành viên năng nổ
Bài viết: 78
Ngày tham gia: T.Tư 26/03/2008 7:56 pm

Re: Set hình nền desktop [Hổ trợ tất cả định dạng ảnh]

Gửi bàigửi bởi tieurongtien » T.Năm 29/05/2008 3:07 pm

rất hay, có cái này thì khỏi phải chuyển sang bmp làm gì
Đừng xấu hổ khi không biết, chỉ xấu hổ khi không học

Hình đại diện của người dùng
clarkkent
Mạnh Thường Quân
Mạnh Thường Quân
Bài viết: 1641
Ngày tham gia: T.Tư 16/04/2008 11:25 am
Đến từ: Chợ Lách - Bến Tre
Been thanked: 31 time
Liên hệ:

Re: Set hình nền desktop [Hổ trợ tất cả định dạng ảnh]

Gửi bàigửi bởi clarkkent » T.Năm 29/05/2008 3:26 pm

Như vậy là nó lẽ lưu thành 1 file giống như Hlml à... :D
• Hôm bây: www.tinsoftware.com ^ ^
Cố gắng lên...

Hình đại diện của người dùng
T7
Thành viên danh dự
Thành viên danh dự
Bài viết: 415
Ngày tham gia: T.Năm 24/05/2007 8:19 pm
Đến từ: Long Xuyên - An Giang
Been thanked: 12 time
Liên hệ:

Re: Set hình nền desktop [Hổ trợ tất cả định dạng ảnh]

Gửi bàigửi bởi T7 » T.Năm 29/05/2008 4:33 pm

clarkkent đã viết:Như vậy là nó lẽ lưu thành 1 file giống như Hlml à... :D

Không, nó không lưu ra bất kì một định dạng nào khác mà sử dụng trực tiếp vào file ảnh đó luôn, anh thử xóa tấm ảnh đang set làm hình nền rồi restart lại máy xem thì sẽ rõ :D
While (i <= you) i++;

Hình đại diện của người dùng
clarkkent
Mạnh Thường Quân
Mạnh Thường Quân
Bài viết: 1641
Ngày tham gia: T.Tư 16/04/2008 11:25 am
Đến từ: Chợ Lách - Bến Tre
Been thanked: 31 time
Liên hệ:

Re: Set hình nền desktop [Hổ trợ tất cả định dạng ảnh]

Gửi bàigửi bởi clarkkent » T.Năm 29/05/2008 4:38 pm

Vậy là vọc Group Policy...
Nếu xài Active Desktop thì không thể chỉnh sửa được hình nền bằng Desktop Properties... :(
• Hôm bây: www.tinsoftware.com ^ ^
Cố gắng lên...

Hình đại diện của người dùng
T7
Thành viên danh dự
Thành viên danh dự
Bài viết: 415
Ngày tham gia: T.Năm 24/05/2007 8:19 pm
Đến từ: Long Xuyên - An Giang
Been thanked: 12 time
Liên hệ:

Re: Set hình nền desktop [Hổ trợ tất cả định dạng ảnh]

Gửi bàigửi bởi T7 » T.Năm 29/05/2008 4:45 pm

clarkkent đã viết:Vậy là vọc Group Policy...
Nếu xài Active Desktop thì không thể chỉnh sửa được hình nền bằng Desktop Properties... :(

Ặc, vẫn sửa được hình nền bằng cách thủ công như thường, cái này xài active desktop nhưng thật sự là nó thay đổi trực tiếp hình nền của desktop luôn (có nghĩ là ở một góc độ nào đó ta có thể hiểu rằng nó thay đổi trực tiếp thông tin trong desktop properties)
While (i <= you) i++;

giongto35
Thành viên danh dự
Thành viên danh dự
Bài viết: 194
Ngày tham gia: T.Năm 19/04/2007 10:17 am
Đến từ: Đà Nẵng City
Been thanked: 1 time
Liên hệ:

Re: Set hình nền desktop [Hổ trợ tất cả định dạng ảnh]

Gửi bàigửi bởi giongto35 » T.Năm 29/05/2008 5:17 pm

T-7 , láo quá, sao tác giả là T-7 , http://www.vbforums.com/archive/index.php/t-367342.html sưu tầm thì nói sưu tầm :-w
Ai đọc code có hiểu gì ko ?
Sửa lần cuối bởi giongto35 vào ngày T.Năm 29/05/2008 7:25 pm với 1 lần sửa.
________________________________________________________________________________________________
. . . . . . . . . . . . .. .

Hình đại diện của người dùng
T7
Thành viên danh dự
Thành viên danh dự
Bài viết: 415
Ngày tham gia: T.Năm 24/05/2007 8:19 pm
Đến từ: Long Xuyên - An Giang
Been thanked: 12 time
Liên hệ:

Re: Set hình nền desktop [Hổ trợ tất cả định dạng ảnh]

Gửi bàigửi bởi T7 » T.Năm 29/05/2008 7:14 pm

giongto35 đã viết:T-7 , láo quá, sao tác giả là T-7 , http://www.vbforums.com/archive/index.php/t-367342.html sưu tầm thì nói sưu tầm :-w
Ai đọc code có hiểu gù ko ?

Ặc, kiếm đâu ra thế ? :| Đoạn code này thật ra do T-7 tìm được trong một phần mềm thay đổi hình nền cách đây lâu lắm rồi nên đã lấy ra cho mọi người xem, tưởng là hok ai biết nên mới... :"> , sorry.
P/s: Phải sửa lại thui :( :((
While (i <= you) i++;


Quay về “[VB] Hệ thống - Tập tin - Thư mục và Mạng”

Đ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.2 khách