none
Setting wallpaper directory programmatically RRS feed

  • Question

  • Hi there

    I am a slightly rusty VB6 developer and have been asked by my firm to write a program which changes the directory of windows desktop wallpaper slideshow based on the day of the month.  Each set of wallpapers for the day is in a subfolder of 'wallpapers\#' where # is the number of the day.  I'm using VS2017 as that's what my firm has and I've managed to extract the day of the month out and can build up the string for the path of the dolfer but then despite numerous searches on the web I don't seem to be able to find the code I need to update the Windows Desktop Wallpaper settings to set the slideshow folder to be the new day.  Anyone able to help me?

    Thanks

    Ben

    Sunday, March 29, 2020 7:24 PM

Answers

  • It is done with IDesktopWallpaper::SetSlideshow

    For example =>

    Dim sPath As String = "E:\Tools\Graphism\DesktopImages"
    pDesktopWallpaper = CType((New DesktopWallpaperClass()), IDesktopWallpaper)
    Dim pShellItem As IShellItem = Nothing
    Dim pShellItemArray As IShellItemArray = Nothing
    Dim hr As HRESULT = SHCreateItemFromParsingName(sPath, IntPtr.Zero, GetType(IShellItem).GUID, pShellItem)
    If (hr = HRESULT.S_OK) Then
        hr = SHCreateShellItemArrayFromShellItem(pShellItem, GetType(IShellItemArray).GUID, pShellItemArray)
        If (hr = HRESULT.S_OK) Then
            hr = pDesktopWallpaper.SetSlideshow(pShellItemArray)
            If (hr = HRESULT.S_OK) Then
                MessageBox.Show(String.Format("Wallpaper Slideshow set to directory : {0}", sPath), "Information", MessageBoxButtons.OK, MessageBoxIcon.Information)
            End If
        End If
    End If

    Declarations :

        Public Enum HRESULT As Integer
            S_OK = 0
            S_FALSE = 1
            E_NOINTERFACE = &H80004002
            E_NOTIMPL = &H80004001
            E_FAIL = &H80004005
            E_UNEXPECTED = &H8000FFFF
            E_OUTOFMEMORY = &H8007000E
        End Enum
    
    
        <ComImport, Guid("C2CF3110-460E-4fc1-B9D0-8A1C0C9CC4BD")>
        Public Class DesktopWallpaperClass
        End Class
    
    
        <ComImport, Guid("B92B56A9-8B55-4E14-9A89-0199BBB6F93B"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
        Interface IDesktopWallpaper
            Function SetWallpaper(<MarshalAs(UnmanagedType.LPWStr)> ByVal monitorID As String, <MarshalAs(UnmanagedType.LPWStr)> ByVal wallpaper As String) As HRESULT
            Function GetWallpaper(<MarshalAs(UnmanagedType.LPWStr)> ByVal monitorID As String, <MarshalAs(UnmanagedType.LPWStr)> ByRef wallpaper As String) As HRESULT
            Function GetMonitorDevicePathAt(ByVal monitorIndex As UInteger, <MarshalAs(UnmanagedType.LPWStr)> ByRef monitorID As String) As HRESULT
            Function GetMonitorDevicePathCount(ByRef count As UInteger) As HRESULT
            Function GetMonitorRECT(<MarshalAs(UnmanagedType.LPWStr)> ByVal monitorID As String, <MarshalAs(UnmanagedType.Struct)> ByRef displayRect As RECT) As HRESULT
            Function SetBackgroundColor(ByVal color As UInteger) As HRESULT
            Function GetBackgroundColor(ByRef color As UInteger) As HRESULT
            Function SetPosition(ByVal position As DESKTOP_WALLPAPER_POSITION) As HRESULT
            Function GetPosition(ByRef position As DESKTOP_WALLPAPER_POSITION) As HRESULT
            Function SetSlideshow(ByVal items As IShellItemArray) As HRESULT
            Function GetSlideshow(ByRef items As IShellItemArray) As HRESULT
            Function SetSlideshowOptions(ByVal options As DESKTOP_SLIDESHOW_OPTIONS, ByVal slideshowTick As UInteger) As HRESULT
            <PreserveSig>
            Function GetSlideshowOptions(<Out> ByRef options As DESKTOP_SLIDESHOW_OPTIONS, <Out> ByRef slideshowTick As UInteger) As HRESULT
            Function AdvanceSlideshow(<MarshalAs(UnmanagedType.LPWStr)> ByVal monitorID As String, ByVal direction As DESKTOP_SLIDESHOW_DIRECTION) As HRESULT
            Function GetStatus(ByRef state As DESKTOP_SLIDESHOW_STATE) As HRESULT
            Function Enable(benable As Boolean) As HRESULT
        End Interface
    
        <StructLayout(LayoutKind.Sequential)>
        Public Structure RECT
            Public left As Integer
            Public top As Integer
            Public right As Integer
            Public bottom As Integer
            Public Sub New(ByVal left As Integer, ByVal top As Integer, ByVal right As Integer, ByVal bottom As Integer)
                Me.left = left
                Me.top = top
                Me.right = right
                Me.bottom = bottom
            End Sub
            Public Shared Function FromXYWH(ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer) As RECT
                Return New RECT(x, y, x + width, y + height)
            End Function
        End Structure
        Public Enum DESKTOP_WALLPAPER_POSITION
            DWPOS_CENTER = 0
            DWPOS_TILE = 1
            DWPOS_STRETCH = 2
            DWPOS_FIT = 3
            DWPOS_FILL = 4
            DWPOS_SPAN = 5
        End Enum
    
        Public Enum DESKTOP_SLIDESHOW_OPTIONS
            DSO_SHUFFLEIMAGES = &H1
        End Enum
    
        Public Enum DESKTOP_SLIDESHOW_STATE
            DSS_ENABLED = &H1
            DSS_SLIDESHOW = &H2
            DSS_DISABLED_BY_REMOTE_SESSION = &H4
        End Enum
    
        Public Enum DESKTOP_SLIDESHOW_DIRECTION
            DSD_FORWARD = 0
            DSD_BACKWARD = 1
        End Enum
    
    
        <ComImport()>
        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
        <Guid("b63ea76d-1f85-456f-a19c-48159efa858b")>
        Public Interface IShellItemArray
            Function BindToHandler(pbc As IntPtr, ByRef bhid As Guid, ByRef riid As Guid, ByRef ppvOut As IntPtr) As HRESULT
            Function GetPropertyStore(flags As GETPROPERTYSTOREFLAGS, ByRef riid As Guid, ByRef ppv As IntPtr) As HRESULT
            Function GetPropertyDescriptionList(keyType As PROPERTYKEY, ByRef riid As Guid, ByRef ppv As IntPtr) As HRESULT
            'Function GetAttributes(AttribFlags As SIATTRIBFLAGS, sfgaoMask As SFGAOF, ByRef psfgaoAttribs As SFGAOF) As HRESULT
            Function GetAttributes(AttribFlags As SIATTRIBFLAGS, sfgaoMask As Integer, ByRef psfgaoAttribs As Integer) As HRESULT
            Function GetCount(ByRef pdwNumItems As Integer) As HRESULT
            Function GetItemAt(dwIndex As Integer, ByRef ppsi As IShellItem) As HRESULT
    
            'Function EnumItems(ByRef ppenumShellItems As IEnumShellItems) As HRESULT
            Function EnumItems(ByRef ppenumShellItems As IntPtr) As HRESULT
        End Interface
    
        <StructLayout(LayoutKind.Sequential, Pack:=4)>
        Public Structure PROPERTYKEY
            Private fmtid As Guid
            Private pid As Integer
            Public ReadOnly Property FormatId() As Guid
                Get
                    Return Me.fmtid
                End Get
            End Property
            Public ReadOnly Property PropertyId() As Integer
                Get
                    Return Me.pid
                End Get
            End Property
            Public Sub New(ByVal formatId As Guid, ByVal propertyId As Integer)
                Me.fmtid = formatId
                Me.pid = propertyId
            End Sub
            Public Shared ReadOnly PKEY_DateCreated As PROPERTYKEY = New PROPERTYKEY(New Guid("B725F130-47EF-101A-A5F1-02608C9EEBAC"), 15)
        End Structure
    
        Public Enum GETPROPERTYSTOREFLAGS
            GPS_DEFAULT = 0
            GPS_HANDLERPROPERTIESONLY = &H1
            GPS_READWRITE = &H2
            GPS_TEMPORARY = &H4
            GPS_FASTPROPERTIESONLY = &H8
            GPS_OPENSLOWITEM = &H10
            GPS_DELAYCREATION = &H20
            GPS_BESTEFFORT = &H40
            GPS_NO_OPLOCK = &H80
            GPS_PREFERQUERYPROPERTIES = &H100
            GPS_EXTRINSICPROPERTIES = &H200
            GPS_EXTRINSICPROPERTIESONLY = &H400
            GPS_MASK_VALID = &H7FF
        End Enum
    
        Public Enum SIATTRIBFLAGS
            SIATTRIBFLAGS_AND = &H1
            SIATTRIBFLAGS_OR = &H2
            SIATTRIBFLAGS_APPCOMPAT = &H3
            SIATTRIBFLAGS_MASK = &H3
            SIATTRIBFLAGS_ALLITEMS = &H4000
        End Enum
    
        <ComImport()>
        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
        <Guid("43826D1E-E718-42EE-BC55-A1E261C37BFE")>
        Public Interface IShellItem
            <PreserveSig()>
            Function BindToHandler(ByVal pbc As IntPtr, ByRef bhid As Guid, ByRef riid As Guid, ByRef ppv As IntPtr) As HRESULT
            Function GetParent(ByRef ppsi As IShellItem) As HRESULT
            Function GetDisplayName(ByVal sigdnName As SIGDN, ByRef ppszName As System.Text.StringBuilder) As HRESULT
            Function GetAttributes(ByVal sfgaoMask As UInteger, ByRef psfgaoAttribs As UInteger) As HRESULT
            Function Compare(ByVal psi As IShellItem, ByVal hint As UInteger, ByRef piOrder As Integer) As HRESULT
        End Interface
    
        Public Enum SIGDN As Integer
            SIGDN_NORMALDISPLAY = &H0
            SIGDN_PARENTRELATIVEPARSING = &H80018001
            SIGDN_DESKTOPABSOLUTEPARSING = &H80028000
            SIGDN_PARENTRELATIVEEDITING = &H80031001
            SIGDN_DESKTOPABSOLUTEEDITING = &H8004C000
            SIGDN_FILESYSPATH = &H80058000
            SIGDN_URL = &H80068000
            SIGDN_PARENTRELATIVEFORADDRESSBAR = &H8007C001
            SIGDN_PARENTRELATIVE = &H80080001
        End Enum
    
        <DllImport("Shell32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)>
        Public Shared Function SHCreateItemFromParsingName(ByVal pszPath As String, ByVal pbc As IntPtr,
        <[In], MarshalAs(UnmanagedType.LPStruct)> ByVal riid As Guid, <Out> ByRef ppv As IShellItem) As HRESULT
        End Function
    
        <DllImport("Shell32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)>
        Public Shared Function SHCreateShellItemArrayFromShellItem(ByVal psi As IShellItem,
        <[In], MarshalAs(UnmanagedType.LPStruct)> ByVal riid As Guid, <Out> ByRef ppv As IShellItemArray) As HRESULT
        End Function

    • Marked as answer by orangebernard Monday, March 30, 2020 8:39 AM
    • Unmarked as answer by orangebernard Monday, March 30, 2020 9:39 AM
    • Marked as answer by orangebernard Monday, March 30, 2020 9:39 AM
    Sunday, March 29, 2020 8:29 PM

All replies

  • Hi

    Here is some code that seems might fit the bill.

    This code would be run from Windows StartUp where it should set the DeskTop wallpaper based on the day of the month from a folder set up for it as per your post.

    In my case, I used a folder on the Desktop for testing and set the WPpath accordingly. I added some images and renamed them all to the pattern    Xwallpaper.jpg  with the X being the day of the month. (necessary)

    This code has had limited testing but seems OK. The part you might be interested in is the SystemParametersInfo which I previously found somewhere online (can't remember where now). I haven't bothered, but the Form can be made borderless and transparent if it is noticed (unlikely) as the code terminates immediately on changing the wallpaper.

    Anyway, can't harm to try it out.

    Option Strict On
    Option Explicit On
    Public Class Form1
      Private Declare Function SystemParametersInfo Lib “user32” Alias “SystemParametersInfoA” (ByVal uAction As Integer, ByVal uParam As Integer, ByVal lpvParam As String, ByVal fuWinIni As Integer) As Integer
    
      Private Const SETDESKWALLPAPER As Integer = 20
      Private Const UPDATEINIFILE As Integer = &H1
    
      Dim WPpath As String = IO.Path.Combine(My.Computer.FileSystem.SpecialDirectories.Desktop, "WPfolder")
      Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Dim fn As String = IO.Path.Combine(WPpath, Now.Day.ToString & "wallpaper.jpg")
    
        SystemParametersInfo(SETDESKWALLPAPER, 0, fn, UPDATEINIFILE)
    
        Application.Exit()
      End Sub
    End Class


    Regards Les, Livingston, Scotland


    • Edited by leshay Sunday, March 29, 2020 8:34 PM typo
    Sunday, March 29, 2020 8:15 PM
  • It is done with IDesktopWallpaper::SetSlideshow

    For example =>

    Dim sPath As String = "E:\Tools\Graphism\DesktopImages"
    pDesktopWallpaper = CType((New DesktopWallpaperClass()), IDesktopWallpaper)
    Dim pShellItem As IShellItem = Nothing
    Dim pShellItemArray As IShellItemArray = Nothing
    Dim hr As HRESULT = SHCreateItemFromParsingName(sPath, IntPtr.Zero, GetType(IShellItem).GUID, pShellItem)
    If (hr = HRESULT.S_OK) Then
        hr = SHCreateShellItemArrayFromShellItem(pShellItem, GetType(IShellItemArray).GUID, pShellItemArray)
        If (hr = HRESULT.S_OK) Then
            hr = pDesktopWallpaper.SetSlideshow(pShellItemArray)
            If (hr = HRESULT.S_OK) Then
                MessageBox.Show(String.Format("Wallpaper Slideshow set to directory : {0}", sPath), "Information", MessageBoxButtons.OK, MessageBoxIcon.Information)
            End If
        End If
    End If

    Declarations :

        Public Enum HRESULT As Integer
            S_OK = 0
            S_FALSE = 1
            E_NOINTERFACE = &H80004002
            E_NOTIMPL = &H80004001
            E_FAIL = &H80004005
            E_UNEXPECTED = &H8000FFFF
            E_OUTOFMEMORY = &H8007000E
        End Enum
    
    
        <ComImport, Guid("C2CF3110-460E-4fc1-B9D0-8A1C0C9CC4BD")>
        Public Class DesktopWallpaperClass
        End Class
    
    
        <ComImport, Guid("B92B56A9-8B55-4E14-9A89-0199BBB6F93B"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
        Interface IDesktopWallpaper
            Function SetWallpaper(<MarshalAs(UnmanagedType.LPWStr)> ByVal monitorID As String, <MarshalAs(UnmanagedType.LPWStr)> ByVal wallpaper As String) As HRESULT
            Function GetWallpaper(<MarshalAs(UnmanagedType.LPWStr)> ByVal monitorID As String, <MarshalAs(UnmanagedType.LPWStr)> ByRef wallpaper As String) As HRESULT
            Function GetMonitorDevicePathAt(ByVal monitorIndex As UInteger, <MarshalAs(UnmanagedType.LPWStr)> ByRef monitorID As String) As HRESULT
            Function GetMonitorDevicePathCount(ByRef count As UInteger) As HRESULT
            Function GetMonitorRECT(<MarshalAs(UnmanagedType.LPWStr)> ByVal monitorID As String, <MarshalAs(UnmanagedType.Struct)> ByRef displayRect As RECT) As HRESULT
            Function SetBackgroundColor(ByVal color As UInteger) As HRESULT
            Function GetBackgroundColor(ByRef color As UInteger) As HRESULT
            Function SetPosition(ByVal position As DESKTOP_WALLPAPER_POSITION) As HRESULT
            Function GetPosition(ByRef position As DESKTOP_WALLPAPER_POSITION) As HRESULT
            Function SetSlideshow(ByVal items As IShellItemArray) As HRESULT
            Function GetSlideshow(ByRef items As IShellItemArray) As HRESULT
            Function SetSlideshowOptions(ByVal options As DESKTOP_SLIDESHOW_OPTIONS, ByVal slideshowTick As UInteger) As HRESULT
            <PreserveSig>
            Function GetSlideshowOptions(<Out> ByRef options As DESKTOP_SLIDESHOW_OPTIONS, <Out> ByRef slideshowTick As UInteger) As HRESULT
            Function AdvanceSlideshow(<MarshalAs(UnmanagedType.LPWStr)> ByVal monitorID As String, ByVal direction As DESKTOP_SLIDESHOW_DIRECTION) As HRESULT
            Function GetStatus(ByRef state As DESKTOP_SLIDESHOW_STATE) As HRESULT
            Function Enable(benable As Boolean) As HRESULT
        End Interface
    
        <StructLayout(LayoutKind.Sequential)>
        Public Structure RECT
            Public left As Integer
            Public top As Integer
            Public right As Integer
            Public bottom As Integer
            Public Sub New(ByVal left As Integer, ByVal top As Integer, ByVal right As Integer, ByVal bottom As Integer)
                Me.left = left
                Me.top = top
                Me.right = right
                Me.bottom = bottom
            End Sub
            Public Shared Function FromXYWH(ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer) As RECT
                Return New RECT(x, y, x + width, y + height)
            End Function
        End Structure
        Public Enum DESKTOP_WALLPAPER_POSITION
            DWPOS_CENTER = 0
            DWPOS_TILE = 1
            DWPOS_STRETCH = 2
            DWPOS_FIT = 3
            DWPOS_FILL = 4
            DWPOS_SPAN = 5
        End Enum
    
        Public Enum DESKTOP_SLIDESHOW_OPTIONS
            DSO_SHUFFLEIMAGES = &H1
        End Enum
    
        Public Enum DESKTOP_SLIDESHOW_STATE
            DSS_ENABLED = &H1
            DSS_SLIDESHOW = &H2
            DSS_DISABLED_BY_REMOTE_SESSION = &H4
        End Enum
    
        Public Enum DESKTOP_SLIDESHOW_DIRECTION
            DSD_FORWARD = 0
            DSD_BACKWARD = 1
        End Enum
    
    
        <ComImport()>
        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
        <Guid("b63ea76d-1f85-456f-a19c-48159efa858b")>
        Public Interface IShellItemArray
            Function BindToHandler(pbc As IntPtr, ByRef bhid As Guid, ByRef riid As Guid, ByRef ppvOut As IntPtr) As HRESULT
            Function GetPropertyStore(flags As GETPROPERTYSTOREFLAGS, ByRef riid As Guid, ByRef ppv As IntPtr) As HRESULT
            Function GetPropertyDescriptionList(keyType As PROPERTYKEY, ByRef riid As Guid, ByRef ppv As IntPtr) As HRESULT
            'Function GetAttributes(AttribFlags As SIATTRIBFLAGS, sfgaoMask As SFGAOF, ByRef psfgaoAttribs As SFGAOF) As HRESULT
            Function GetAttributes(AttribFlags As SIATTRIBFLAGS, sfgaoMask As Integer, ByRef psfgaoAttribs As Integer) As HRESULT
            Function GetCount(ByRef pdwNumItems As Integer) As HRESULT
            Function GetItemAt(dwIndex As Integer, ByRef ppsi As IShellItem) As HRESULT
    
            'Function EnumItems(ByRef ppenumShellItems As IEnumShellItems) As HRESULT
            Function EnumItems(ByRef ppenumShellItems As IntPtr) As HRESULT
        End Interface
    
        <StructLayout(LayoutKind.Sequential, Pack:=4)>
        Public Structure PROPERTYKEY
            Private fmtid As Guid
            Private pid As Integer
            Public ReadOnly Property FormatId() As Guid
                Get
                    Return Me.fmtid
                End Get
            End Property
            Public ReadOnly Property PropertyId() As Integer
                Get
                    Return Me.pid
                End Get
            End Property
            Public Sub New(ByVal formatId As Guid, ByVal propertyId As Integer)
                Me.fmtid = formatId
                Me.pid = propertyId
            End Sub
            Public Shared ReadOnly PKEY_DateCreated As PROPERTYKEY = New PROPERTYKEY(New Guid("B725F130-47EF-101A-A5F1-02608C9EEBAC"), 15)
        End Structure
    
        Public Enum GETPROPERTYSTOREFLAGS
            GPS_DEFAULT = 0
            GPS_HANDLERPROPERTIESONLY = &H1
            GPS_READWRITE = &H2
            GPS_TEMPORARY = &H4
            GPS_FASTPROPERTIESONLY = &H8
            GPS_OPENSLOWITEM = &H10
            GPS_DELAYCREATION = &H20
            GPS_BESTEFFORT = &H40
            GPS_NO_OPLOCK = &H80
            GPS_PREFERQUERYPROPERTIES = &H100
            GPS_EXTRINSICPROPERTIES = &H200
            GPS_EXTRINSICPROPERTIESONLY = &H400
            GPS_MASK_VALID = &H7FF
        End Enum
    
        Public Enum SIATTRIBFLAGS
            SIATTRIBFLAGS_AND = &H1
            SIATTRIBFLAGS_OR = &H2
            SIATTRIBFLAGS_APPCOMPAT = &H3
            SIATTRIBFLAGS_MASK = &H3
            SIATTRIBFLAGS_ALLITEMS = &H4000
        End Enum
    
        <ComImport()>
        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
        <Guid("43826D1E-E718-42EE-BC55-A1E261C37BFE")>
        Public Interface IShellItem
            <PreserveSig()>
            Function BindToHandler(ByVal pbc As IntPtr, ByRef bhid As Guid, ByRef riid As Guid, ByRef ppv As IntPtr) As HRESULT
            Function GetParent(ByRef ppsi As IShellItem) As HRESULT
            Function GetDisplayName(ByVal sigdnName As SIGDN, ByRef ppszName As System.Text.StringBuilder) As HRESULT
            Function GetAttributes(ByVal sfgaoMask As UInteger, ByRef psfgaoAttribs As UInteger) As HRESULT
            Function Compare(ByVal psi As IShellItem, ByVal hint As UInteger, ByRef piOrder As Integer) As HRESULT
        End Interface
    
        Public Enum SIGDN As Integer
            SIGDN_NORMALDISPLAY = &H0
            SIGDN_PARENTRELATIVEPARSING = &H80018001
            SIGDN_DESKTOPABSOLUTEPARSING = &H80028000
            SIGDN_PARENTRELATIVEEDITING = &H80031001
            SIGDN_DESKTOPABSOLUTEEDITING = &H8004C000
            SIGDN_FILESYSPATH = &H80058000
            SIGDN_URL = &H80068000
            SIGDN_PARENTRELATIVEFORADDRESSBAR = &H8007C001
            SIGDN_PARENTRELATIVE = &H80080001
        End Enum
    
        <DllImport("Shell32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)>
        Public Shared Function SHCreateItemFromParsingName(ByVal pszPath As String, ByVal pbc As IntPtr,
        <[In], MarshalAs(UnmanagedType.LPStruct)> ByVal riid As Guid, <Out> ByRef ppv As IShellItem) As HRESULT
        End Function
    
        <DllImport("Shell32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)>
        Public Shared Function SHCreateShellItemArrayFromShellItem(ByVal psi As IShellItem,
        <[In], MarshalAs(UnmanagedType.LPStruct)> ByVal riid As Guid, <Out> ByRef ppv As IShellItemArray) As HRESULT
        End Function

    • Marked as answer by orangebernard Monday, March 30, 2020 8:39 AM
    • Unmarked as answer by orangebernard Monday, March 30, 2020 9:39 AM
    • Marked as answer by orangebernard Monday, March 30, 2020 9:39 AM
    Sunday, March 29, 2020 8:29 PM
  • @Castorix31

    Hi

    I must not have understood the question correctly. If the real answer needs all of the code you posted then mine just has to be wrong. 😒


    Regards Les, Livingston, Scotland

    Sunday, March 29, 2020 8:32 PM
  • @Castorix31

    Hi

    I must not have understood the question correctly. If the real answer needs all of the code you posted then mine just has to be wrong. 😒


    Regards Les, Livingston, Scotland

    SystemParametersInfo is used to change the desktop wallpaper (a file)

    Apparently, the OP wants to change the directory for the desktop wallpaper Slideshow (I tested on Windows 10; this slideshow did not exist on older OS, >= Windows 8 from the doc)

    Sunday, March 29, 2020 8:40 PM
  • Thanks for this - I'll give it a go later this morning and apologies to other poster for not explaining myself overly well.  I'll keep the other code in case I'm asked for something different again!
    Monday, March 30, 2020 8:40 AM
  • Sorry to ask for help again!  I'm now getting a 'MissingManifestResourceException' when I try to run in debug mode - it's falling over on the call to InitializeComponent() in Public Sub New().  Any ideas gratefully received.  IN case it helps I'm copying the code here - the program puts a little window in the bottom corner of the screen with the time on and a copy of the desktop wallpaper from the slideshow of the day.  The additional code is that to update the wallpaper slideshow path by the day of the month as users were having to do this manually each day.

    Thanks

    Ben


    Monday, March 30, 2020 9:43 AM
  • Sorry to ask for help again!  I'm now getting a 'MissingManifestResourceException' when I try to run in debug mode - it's falling over on the call to InitializeComponent() in Public Sub New().  Any ideas gratefully received.  IN case it helps I'm copying the code here - the program puts a little window in the bottom corner of the screen with the time on and a copy of the desktop wallpaper from the slideshow of the day.  The additional code is that to update the wallpaper slideshow path by the day of the month as users were having to do this manually each day.

    Thanks

    Ben


    Public Enum HRESULT As Integer
        S_OK = 0
        S_FALSE = 1
        E_NOINTERFACE = &H80004002
        E_NOTIMPL = &H80004001
        E_FAIL = &H80004005
        E_UNEXPECTED = &H8000FFFF
        E_OUTOFMEMORY = &H8007000E
    End Enum

    <ComImport, Guid("C2CF3110-460E-4fc1-B9D0-8A1C0C9CC4BD")>
    Public Class DesktopWallpaperClass
    End Class

    <ComImport, Guid("B92B56A9-8B55-4E14-9A89-0199BBB6F93B"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
    Interface IDesktopWallpaper
        Function SetWallpaper(<MarshalAs(UnmanagedType.LPWStr)> ByVal monitorID As String, <MarshalAs(UnmanagedType.LPWStr)> ByVal wallpaper As String) As HRESULT
        Function GetWallpaper(<MarshalAs(UnmanagedType.LPWStr)> ByVal monitorID As String, <MarshalAs(UnmanagedType.LPWStr)> ByRef wallpaper As String) As HRESULT
        Function GetMonitorDevicePathAt(ByVal monitorIndex As UInteger, <MarshalAs(UnmanagedType.LPWStr)> ByRef monitorID As String) As HRESULT
        Function GetMonitorDevicePathCount(ByRef count As UInteger) As HRESULT
        Function GetMonitorRECT(<MarshalAs(UnmanagedType.LPWStr)> ByVal monitorID As String, <MarshalAs(UnmanagedType.Struct)> ByRef displayRect As RECT) As HRESULT
        Function SetBackgroundColor(ByVal color As UInteger) As HRESULT
        Function GetBackgroundColor(ByRef color As UInteger) As HRESULT
        Function SetPosition(ByVal position As DESKTOP_WALLPAPER_POSITION) As HRESULT
        Function GetPosition(ByRef position As DESKTOP_WALLPAPER_POSITION) As HRESULT
        Function SetSlideshow(ByVal items As IShellItemArray) As HRESULT
        Function GetSlideshow(ByRef items As IShellItemArray) As HRESULT
        Function SetSlideshowOptions(ByVal options As DESKTOP_SLIDESHOW_OPTIONS, ByVal slideshowTick As UInteger) As HRESULT
        <PreserveSig>
        Function GetSlideshowOptions(<Out> ByRef options As DESKTOP_SLIDESHOW_OPTIONS, <Out> ByRef slideshowTick As UInteger) As HRESULT
        Function AdvanceSlideshow(<MarshalAs(UnmanagedType.LPWStr)> ByVal monitorID As String, ByVal direction As DESKTOP_SLIDESHOW_DIRECTION) As HRESULT
        Function GetStatus(ByRef state As DESKTOP_SLIDESHOW_STATE) As HRESULT
        Function Enable(benable As Boolean) As HRESULT
    End Interface

    <StructLayout(LayoutKind.Sequential)>
    Public Structure RECT
        Public left As Integer
        Public top As Integer
        Public right As Integer
        Public bottom As Integer
        Public Sub New(ByVal left As Integer, ByVal top As Integer, ByVal right As Integer, ByVal bottom As Integer)
            Me.left = left
            Me.top = top
            Me.right = right
            Me.bottom = bottom
        End Sub
        Public Shared Function FromXYWH(ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer) As RECT
            Return New RECT(x, y, x + width, y + height)
        End Function
    End Structure
    Public Enum DESKTOP_WALLPAPER_POSITION
        DWPOS_CENTER = 0
        DWPOS_TILE = 1
        DWPOS_STRETCH = 2
        DWPOS_FIT = 3
        DWPOS_FILL = 4
        DWPOS_SPAN = 5
    End Enum

    Public Enum DESKTOP_SLIDESHOW_OPTIONS
        DSO_SHUFFLEIMAGES = &H1
    End Enum

    Public Enum DESKTOP_SLIDESHOW_STATE
        DSS_ENABLED = &H1
        DSS_SLIDESHOW = &H2
        DSS_DISABLED_BY_REMOTE_SESSION = &H4
    End Enum

    Public Enum DESKTOP_SLIDESHOW_DIRECTION
        DSD_FORWARD = 0
        DSD_BACKWARD = 1
    End Enum


    <ComImport()>
    <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
    <Guid("b63ea76d-1f85-456f-a19c-48159efa858b")>
    Public Interface IShellItemArray
        Function BindToHandler(pbc As IntPtr, ByRef bhid As Guid, ByRef riid As Guid, ByRef ppvOut As IntPtr) As HRESULT
        Function GetPropertyStore(flags As GETPROPERTYSTOREFLAGS, ByRef riid As Guid, ByRef ppv As IntPtr) As HRESULT
        Function GetPropertyDescriptionList(keyType As PROPERTYKEY, ByRef riid As Guid, ByRef ppv As IntPtr) As HRESULT
        'Function GetAttributes(AttribFlags As SIATTRIBFLAGS, sfgaoMask As SFGAOF, ByRef psfgaoAttribs As SFGAOF) As HRESULT
        Function GetAttributes(AttribFlags As SIATTRIBFLAGS, sfgaoMask As Integer, ByRef psfgaoAttribs As Integer) As HRESULT
        Function GetCount(ByRef pdwNumItems As Integer) As HRESULT
        Function GetItemAt(dwIndex As Integer, ByRef ppsi As IShellItem) As HRESULT

        'Function EnumItems(ByRef ppenumShellItems As IEnumShellItems) As HRESULT
        Function EnumItems(ByRef ppenumShellItems As IntPtr) As HRESULT
    End Interface

    <StructLayout(LayoutKind.Sequential, Pack:=4)>
    Public Structure PROPERTYKEY
        Private fmtid As Guid
        Private pid As Integer
        Public ReadOnly Property FormatId() As Guid
            Get
                Return Me.fmtid
            End Get
        End Property
        Public ReadOnly Property PropertyId() As Integer
            Get
                Return Me.pid
            End Get
        End Property
        Public Sub New(ByVal formatId As Guid, ByVal propertyId As Integer)
            Me.fmtid = formatId
            Me.pid = propertyId
        End Sub
        Public Shared ReadOnly PKEY_DateCreated As PROPERTYKEY = New PROPERTYKEY(New Guid("B725F130-47EF-101A-A5F1-02608C9EEBAC"), 15)
    End Structure

    Public Enum GETPROPERTYSTOREFLAGS
        GPS_DEFAULT = 0
        GPS_HANDLERPROPERTIESONLY = &H1
        GPS_READWRITE = &H2
        GPS_TEMPORARY = &H4
        GPS_FASTPROPERTIESONLY = &H8
        GPS_OPENSLOWITEM = &H10
        GPS_DELAYCREATION = &H20
        GPS_BESTEFFORT = &H40
        GPS_NO_OPLOCK = &H80
        GPS_PREFERQUERYPROPERTIES = &H100
        GPS_EXTRINSICPROPERTIES = &H200
        GPS_EXTRINSICPROPERTIESONLY = &H400
        GPS_MASK_VALID = &H7FF
    End Enum

    Public Enum SIATTRIBFLAGS
        SIATTRIBFLAGS_AND = &H1
        SIATTRIBFLAGS_OR = &H2
        SIATTRIBFLAGS_APPCOMPAT = &H3
        SIATTRIBFLAGS_MASK = &H3
        SIATTRIBFLAGS_ALLITEMS = &H4000
    End Enum

    <ComImport()>
    <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
    <Guid("43826D1E-E718-42EE-BC55-A1E261C37BFE")>
    Public Interface IShellItem
        <PreserveSig()>
        Function BindToHandler(ByVal pbc As IntPtr, ByRef bhid As Guid, ByRef riid As Guid, ByRef ppv As IntPtr) As HRESULT
        Function GetParent(ByRef ppsi As IShellItem) As HRESULT
        Function GetDisplayName(ByVal sigdnName As SIGDN, ByRef ppszName As System.Text.StringBuilder) As HRESULT
        Function GetAttributes(ByVal sfgaoMask As UInteger, ByRef psfgaoAttribs As UInteger) As HRESULT
        Function Compare(ByVal psi As IShellItem, ByVal hint As UInteger, ByRef piOrder As Integer) As HRESULT
    End Interface

    Public Enum SIGDN As Integer
        SIGDN_NORMALDISPLAY = &H0
        SIGDN_PARENTRELATIVEPARSING = &H80018001
        SIGDN_DESKTOPABSOLUTEPARSING = &H80028000
        SIGDN_PARENTRELATIVEEDITING = &H80031001
        SIGDN_DESKTOPABSOLUTEEDITING = &H8004C000
        SIGDN_FILESYSPATH = &H80058000
        SIGDN_URL = &H80068000
        SIGDN_PARENTRELATIVEFORADDRESSBAR = &H8007C001
        SIGDN_PARENTRELATIVE = &H80080001
    End Enum

    Public Class frmWPaper

        <DllImport("Shell32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)>
        Public Shared Function SHCreateItemFromParsingName(ByVal pszPath As String, ByVal pbc As IntPtr,
        <[In], MarshalAs(UnmanagedType.LPStruct)> ByVal riid As Guid, <Out> ByRef ppv As IShellItem) As HRESULT
        End Function

        <DllImport("Shell32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)>
        Public Shared Function SHCreateShellItemArrayFromShellItem(ByVal psi As IShellItem,
        <[In], MarshalAs(UnmanagedType.LPStruct)> ByVal riid As Guid, <Out> ByRef ppv As IShellItemArray) As HRESULT
        End Function


        Private Declare Function SystemParametersInfo Lib "user32.dll" Alias "SystemParametersInfoA" _
                (ByVal uAction As Integer, ByVal uParam As Integer, ByVal lpvParam As String, ByVal fuWinIni As Integer) As Integer

        Public Shared SPI_SETDESKTOPWALLPAPER As Integer = 20
        Public Shared SPIF_UPDATEINIFILE As Integer = 1
        Public Shared SPIF_SENDWININICHANGE As Integer = 2
    Monday, March 30, 2020 9:43 AM

  • This follows on from the previous lot of code

     Public Sub New()

            ' This call is required by the designer.
            InitializeComponent()

            ' Add any initialization after the InitializeComponent() call.

        End Sub

        Private Sub frmWPaper_Load(sender As Object, e As EventArgs) Handles MyBase.Load

            On Error Resume Next

            Dim x As Integer
            Dim y As Integer
            Dim iMonth As Integer
            Dim iNow As Date
            Dim sPath As String
            Dim pDesktopWallpaper As IDesktopWallpaper
            Dim pShellItem As IShellItem = Nothing
            Dim pShellItemArray As IShellItemArray = Nothing

            'first set path for photos to the right month
            iNow = Now
            iMonth = Month(iNow)

            'get slideshow folder
            sPath = "D:\Data\data\wpap\" & iMonth
            pDesktopWallpaper = CType((New DesktopWallpaperClass()), IDesktopWallpaper)

            'set folder to system
            Dim hr As HRESULT = SHCreateItemFromParsingName(sPath, IntPtr.Zero, GetType(IShellItem).GUID, pShellItem)
            If (hr = HRESULT.S_OK) Then
                hr = SHCreateShellItemArrayFromShellItem(pShellItem, GetType(IShellItemArray).GUID, pShellItemArray)
                If (hr = HRESULT.S_OK) Then
                    hr = pDesktopWallpaper.SetSlideshow(pShellItemArray)
                    If (hr = HRESULT.S_OK) Then
                        MessageBox.Show(String.Format("Wallpaper Slideshow set to directory : {0}", sPath), "Information", MessageBoxButtons.OK, MessageBoxIcon.Information)
                    End If
                End If
            End If



            'get screen size and work out where to put the form
            x = Screen.PrimaryScreen.WorkingArea.Width
            y = Screen.PrimaryScreen.WorkingArea.Height

            Me.Location = New Point(x - 270, y - 225)

            'System.IO.File.Copy("C:\Users\revbc\AppData\Roaming\Microsoft\Windows\Themes\TranscodedWallpaper", "C:\Users\revbc\AppData\Roaming\Microsoft\Windows\Themes\CurrentWallpaper1", True)
            My.Computer.FileSystem.CopyFile("C:\Users\revbc\AppData\Roaming\Microsoft\Windows\Themes\TranscodedWallpaper", "C:\Users\revbc\AppData\Roaming\Microsoft\Windows\Themes\CurrentWallpaper1", overwrite:=True)
            'My.Computer.FileSystem.CopyFile("C:\Users\revbc\AppData\Roaming\Microsoft\Windows\Themes\CurrentWallpaper1", "C:\Users\revbc\AppData\Roaming\Microsoft\Windows\Themes\CurrentWallpaper2", overwrite:=True)
            picWPaper.Image = Image.FromFile("C:\Users\revbc\AppData\Roaming\Microsoft\Windows\Themes\CurrentWallpaper1")
            tmrTimer.Start()
            lblCurrentTime.Text = Format(TimeOfDay, "h:mm:ss tt")

        End Sub

        Private Sub tmrTimer_Tick(sender As Object, e As EventArgs) Handles tmrTimer.Tick

            On Error Resume Next

            If (picWPaper.Image IsNot Nothing) Then
                picWPaper.Image.Dispose()
            End If
            'picWPaper.Image = Image.FromFile("C:\Users\revbc\AppData\Roaming\Microsoft\Windows\Themes\CurrentWallpaper2")
            My.Computer.FileSystem.CopyFile("C:\Users\revbc\AppData\Roaming\Microsoft\Windows\Themes\TranscodedWallpaper", "C:\Users\revbc\AppData\Roaming\Microsoft\Windows\Themes\CurrentWallpaper1", overwrite:=True)
            picWPaper.Image = Image.FromFile("C:\Users\revbc\AppData\Roaming\Microsoft\Windows\Themes\CurrentWallpaper1")
            'My.Computer.FileSystem.CopyFile("C:\Users\revbc\AppData\Roaming\Microsoft\Windows\Themes\CurrentWallpaper1", "C:\Users\revbc\AppData\Roaming\Microsoft\Windows\Themes\CurrentWallpaper2", overwrite:=True)
            lblCurrentTime.Text = Format(TimeOfDay, "h:mm:ss tt")

            Exit Sub

    ErrHandler:

            If (picWPaper.Image IsNot Nothing) Then
                picWPaper.Image.Dispose()
            End If
            My.Computer.FileSystem.CopyFile("C:\Users\revbc\AppData\Roaming\Microsoft\Windows\Themes\TranscodedWallpaper", "C:\Users\revbc\AppData\Roaming\Microsoft\Windows\Themes\CurrentWallpaper1", overwrite:=True)
            picWPaper.Image = Image.FromFile("C:\Users\revbc\AppData\Roaming\Microsoft\Windows\Themes\CurrentWallpaper1")

        End Sub

        Private Sub cmdExit_Click(sender As Object, e As EventArgs) Handles cmdExit.Click

            Me.Close()

        End Sub
    End Class

    Monday, March 30, 2020 9:44 AM
  • Sorry to ask for help again!  I'm now getting a 'MissingManifestResourceException' when I try to run in debug mode - it's falling over on the call to InitializeComponent() in Public Sub New().  Any ideas gratefully received.  

    This doesn't seem related to the code

    See : how to fix 'System.Resources.MissingManifestResourceException' error?

    (and use the Tag to Insert code when you copy-paste code...)

    Monday, March 30, 2020 10:06 AM
  • Thank you - all sorted and working now.  Somehow my Windows Form had got in a twist and to fix it I had to remove the form and recreate it.
    Monday, March 30, 2020 11:52 AM