Results 1 to 3 of 3

Thread: VB6 - JPEGs as wallpapers (without conversion)

  1. #1

    Thread Starter
    Lively Member rm_03's Avatar
    Join Date
    Aug 2004
    Posts
    92

    VB6 - JPEGs as wallpapers (without conversion)

    Hi there,

    today I want to show you how to access IActiveDesktop to set
    a new wallpaper (Active Desktop has to be enabled).
    Actually nothing special, just declare IActiveDesktop in a type library,
    and instance it with the "new" keyword in VB.
    In this example I did it without the use of a type lib. Hardcore!!

    Put the following in a module:
    VB Code:
    1. Option Explicit
    2.  
    3. Private Declare Function IIDFromString Lib "ole32" ( _
    4.   ByVal lpszIID As Long, _
    5.   iid As Any) As Long
    6.  
    7. Private Declare Function CoCreateInstance Lib "ole32" ( _
    8.   rclsid As Any, _
    9.   ByVal pUnkOuter As Long, _
    10.   ByVal dwClsContext As Long, _
    11.   riid As Any, _
    12.   ByVal ppv As Long) As Long
    13.  
    14. Private Declare Function CallWindowProcA Lib "user32" ( _
    15.   ByVal addr As Long, _
    16.   ByVal p1 As Long, _
    17.   ByVal p2 As Long, _
    18.   ByVal p3 As Long, _
    19.   ByVal p4 As Long) As Long
    20.  
    21. Private Declare Sub RtlMoveMemory Lib "kernel32" ( _
    22.   pDst As Any, _
    23.   pSrc As Any, _
    24.   ByVal dlen As Long)
    25.  
    26. Private Const CLSCTX_INPROC_SERVER  As Long = 1&
    27.  
    28. Private Const CLSID_ActiveDesktop   As String = "{75048700-EF1F-11D0-9888-006097DEACF9}"
    29. Private Const IID_ActiveDesktop     As String = "{F490EB00-1240-11D1-9888-006097DEACF9}"
    30.  
    31. Private Type GUID
    32.   data1                   As Long
    33.   data2                   As Integer
    34.   data3                   As Integer
    35.   data4(7)                As Byte
    36. End Type
    37.  
    38. Private Type IActiveDesktop
    39.   ' IUnknown
    40.   QueryInterface          As Long
    41.   AddRef                  As Long
    42.   Release                 As Long
    43.   ' IActiveDesktop
    44.   ApplyChanges            As Long
    45.   GetWallpaper            As Long
    46.   SetWallpaper            As Long
    47.   GetWallpaperOptions     As Long
    48.   SetWallpaperOptions     As Long
    49.   GetPattern              As Long
    50.   SetPattern              As Long
    51.   GetDesktopItemOptions   As Long
    52.   SetDesktopItemOptions   As Long
    53.   AddDesktopItem          As Long
    54.   AddDesktopItemWithUI    As Long
    55.   ModifyDesktopItem       As Long
    56.   RemoveDesktopItem       As Long
    57.   GetDesktopItemCount     As Long
    58.   GetDesktopItem          As Long
    59.   GetDesktopItemByID      As Long
    60.   GenerateDesktopItemHtml As Long
    61.   AddUrl                  As Long
    62.   GetDesktopItemBySource  As Long
    63. End Type
    64.  
    65. Private Enum AD_APPLY
    66.   AD_APPLY_SAVE = &H1
    67.   AD_APPLY_HTMLGEN = &H2
    68.   AD_APPLY_REFRESH = &H4
    69.   AD_APPLY_ALL = &H7
    70.   AD_APPLY_FORCE = &H8
    71.   AD_APPLY_BUFFERED_REFRESH = &H10
    72.   AD_APPLY_DYNAMICREFRESH = &H20
    73. End Enum
    74.  
    75. Public Function ActiveDesktopSetWallpaper( _
    76.     ByVal strFile As String _
    77. ) As Boolean
    78.  
    79.     Dim vtbl            As IActiveDesktop
    80.     Dim vtblptr         As Long
    81.  
    82.     Dim classid         As GUID
    83.     Dim iid             As GUID
    84.  
    85.     Dim obj             As Long
    86.     Dim hRes            As Long
    87.  
    88.     ' CLSID (BSTR) to CLSID (GUID)
    89.     hRes = IIDFromString(StrPtr(CLSID_ActiveDesktop), classid)
    90.     If hRes <> 0 Then
    91.         Exit Function
    92.     End If
    93.  
    94.     ' IID (BSTR) to IID (GUID)
    95.     hRes = IIDFromString(StrPtr(IID_ActiveDesktop), iid)
    96.     If hRes <> 0 Then
    97.         Exit Function
    98.     End If
    99.  
    100.     ' create an instance of IActiveDesktop
    101.     ' (Set IActiveDesktop = New IActiveDesktop)
    102.     hRes = CoCreateInstance(classid, 0, CLSCTX_INPROC_SERVER, iid, VarPtr(obj))
    103.     If hRes <> 0 Then
    104.         Exit Function
    105.     End If
    106.  
    107.     ' obj points now to a pointer to the VTable
    108.     ' of IActiveDesktop
    109.     '
    110.     ' dereference the VTable pointer
    111.     RtlMoveMemory vtblptr, ByVal obj, 4
    112.     ' copy the VTable to our IActiveDesktop structure
    113.     RtlMoveMemory vtbl, ByVal vtblptr, Len(vtbl)
    114.  
    115.     ' call IActiveDesktop::SetWallpaper
    116.     '
    117.     ' the first parameter is always the object pointer
    118.     ' the return value should always be a HRESULT (0 = S_OK)
    119.     hRes = CallPointer(vtbl.SetWallpaper, obj, StrPtr(strFile), 0)
    120.     If hRes = 0 Then
    121.         ActiveDesktopSetWallpaper = True
    122.     End If
    123.  
    124.     ' call IActiveDesktop::ApplyChanges
    125.     hRes = CallPointer(vtbl.ApplyChanges, obj, AD_APPLY_ALL Or AD_APPLY_FORCE)
    126.  
    127.     ' release IActiveDesktop to free memory
    128.     ' (Set IActiveDesktop = Nothing)
    129.     CallPointer vtbl.Release, obj
    130. End Function
    131.  
    132. Private Function CallPointer( _
    133.     ByVal fnc As Long, _
    134.     ParamArray params() _
    135. ) As Long
    136.  
    137.   Dim btASM(&HEC00& - 1)  As Byte
    138.   Dim pASM                As Long
    139.   Dim i                   As Integer
    140.  
    141.   pASM = VarPtr(btASM(0))
    142.  
    143.   AddByte pASM, &H58                  ' POP EAX
    144.   AddByte pASM, &H59                  ' POP ECX
    145.   AddByte pASM, &H59                  ' POP ECX
    146.   AddByte pASM, &H59                  ' POP ECX
    147.   AddByte pASM, &H59                  ' POP ECX
    148.   AddByte pASM, &H50                  ' PUSH EAX
    149.  
    150.   For i = UBound(params) To 0 Step -1
    151.     AddPush pASM, CLng(params(i))     ' PUSH dword
    152.   Next
    153.  
    154.   AddCall pASM, fnc                   ' CALL rel addr
    155.   AddByte pASM, &HC3                  ' RET
    156.  
    157.   CallPointer = CallWindowProcA(VarPtr(btASM(0)), 0, 0, 0, 0)
    158. End Function
    159.  
    160. Private Sub AddPush(pASM As Long, lng As Long)
    161.   AddByte pASM, &H68
    162.   AddLong pASM, lng
    163. End Sub
    164.  
    165. Private Sub AddCall(pASM As Long, addr As Long)
    166.   AddByte pASM, &HE8
    167.   AddLong pASM, addr - pASM - 4
    168. End Sub
    169.  
    170. Private Sub AddLong(pASM As Long, lng As Long)
    171.   RtlMoveMemory ByVal pASM, lng, 4
    172.   pASM = pASM + 4
    173. End Sub
    174.  
    175. Private Sub AddByte(pASM As Long, bt As Byte)
    176.   RtlMoveMemory ByVal pASM, bt, 1
    177.   pASM = pASM + 1
    178. End Sub

    How to use it:
    VB Code:
    1. If ActiveDesktopSetWallpaper("C:\wallpaper.jpg") Then
    2.     MsgBox "Successfully set new wallpaper"
    3. Else
    4.     MsgBox "Failed to set new wallpaper"
    5. End If

  2. #2
    New Member
    Join Date
    Dec 2005
    Posts
    2

    Re: VB6 - JPEGs as wallpapers (without conversion)

    Hello,can you show how to modify this code to apply Active Desktop Item?? And how to make use of this COMPONENT to setup the Active Destop Item setting??

    http://msdn.microsoft.com/library/de.../component.asp

    VB Code:
    1. typedef struct _tagCOMPONENT {
    2.     DWORD dwSize;
    3.     DWORD dwID;
    4.     int iComponentType;
    5.     BOOL fChecked;
    6.     BOOL fDirty;
    7.     BOOL fNoScroll;
    8.     COMPPOS cpPos;
    9.     WCHAR wszFriendlyName[MAX_PATH];
    10.     WCHAR wszSource[INTERNET_MAX_URL_LENGTH];
    11.     WCHAR wszSubscribedURL[INTERNET_MAX_URL_LENGTH];
    12.     DWORD dwCurItemState;
    13.     COMPSTATEINFO csiOriginal;
    14.     COMPSTATEINFO csiRestored;
    15. } COMPONENT, *LPCO

    Thanks for any guide.
    Last edited by ktxmax; Dec 11th, 2005 at 08:00 AM.

  3. #3
    Fanatic Member schoolbusdriver's Avatar
    Join Date
    Jan 2006
    Location
    O'er yonder
    Posts
    1,020

    Thumbs up Re: VB6 - JPEGs as wallpapers (without conversion)

    Many thanks for this rm_03. You've understated your code! It works for HTM files too.
    Last edited by schoolbusdriver; Jun 30th, 2006 at 02:59 AM. Reason: Too much waffle.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width