Back
Imports System.Runtime.InteropServices
Imports System.Text

Public Class Form1
    Inherits System.Windows.Forms.Form
#Region Windows Form Designer generated code
 

    Public Sub New()
        MyBase.New()
        Application.EnableVisualStyles()
        Application.DoEvents()
        'This call is required by the Windows Form Designer.
        InitializeComponent()

        'Add any initialization after the InitializeComponent() call

    End Sub

    'Form overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    Friend WithEvents Button1 As System.Windows.Forms.Button
    Friend WithEvents Button2 As System.Windows.Forms.Button
    Friend WithEvents Label1 As System.Windows.Forms.Label
    Friend WithEvents PictureBox1 As System.Windows.Forms.PictureBox
     Private Sub InitializeComponent()
        Me.Button1 = New System.Windows.Forms.Button
        Me.Button2 = New System.Windows.Forms.Button
        Me.Label1 = New System.Windows.Forms.Label
        Me.PictureBox1 = New System.Windows.Forms.PictureBox
        Me.SuspendLayout()
        '
        'Button1
        '
        Me.Button1.FlatStyle = System.Windows.Forms.FlatStyle.System
        Me.Button1.Location = New System.Drawing.Point(24, 0)
        Me.Button1.Name = "Button1"
        Me.Button1.Size = New System.Drawing.Size(192, 23)
        Me.Button1.TabIndex = 0
        Me.Button1.Text = "Get Wallpaper"
        '
        'Button2
        '
        Me.Button2.FlatStyle = System.Windows.Forms.FlatStyle.System
        Me.Button2.Location = New System.Drawing.Point(240, 0)
        Me.Button2.Name = "Button2"
        Me.Button2.Size = New System.Drawing.Size(216, 23)
        Me.Button2.TabIndex = 1
        Me.Button2.Text = "Set Wallpaper"
        '
        'Label1
        '
        Me.Label1.FlatStyle = System.Windows.Forms.FlatStyle.System
        Me.Label1.Location = New System.Drawing.Point(0, 24)
        Me.Label1.Name = "Label1"
        Me.Label1.Size = New System.Drawing.Size(472, 23)
        Me.Label1.TabIndex = 2
        Me.Label1.TextAlign = System.Drawing.ContentAlignment.MiddleCenter
        '
        'PictureBox1
        '
        Me.PictureBox1.BorderStyle = System.Windows.Forms.BorderStyle.Fixed3D
        Me.PictureBox1.Location = New System.Drawing.Point(0, 48)
        Me.PictureBox1.Name = "PictureBox1"
        Me.PictureBox1.Size = New System.Drawing.Size(472, 280)
        Me.PictureBox1.TabIndex = 3
        Me.PictureBox1.TabStop = False
        '
        'Form1
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.ClientSize = New System.Drawing.Size(472, 326)
        Me.Controls.Add(Me.PictureBox1)
        Me.Controls.Add(Me.Label1)
        Me.Controls.Add(Me.Button2)
        Me.Controls.Add(Me.Button1)
        Me.MaximizeBox = False
        Me.Name = "Form1"
        Me.Text = "IActive Desktop ( by Dynamic Sysop )"
        Me.ResumeLayout(False)

    End Sub

#End Region
    <DllImport("OLE32.DLL")> _
    Public Shared Function CoCreateInstance( _
         ByRef ClassGuid As Guid, _
         ByVal pUnkOuter As IntPtr, _
         ByVal dwClsContext As Integer, _
         ByRef InterfaceGuid As Guid, _
         ByRef Result As IActiveDesktop) As IntPtr
    End Function

    Private CLSID_ActiveDesktop As New Guid("75048700-EF1F-11D0-9888-006097DEACF9")
    Private IID_IActiveDesktop As New Guid("F490EB00-1240-11D1-9888-006097DEACF9")
    Private Const CLSCTX_INPROC_SERVER As Integer = 1

    Private ActiveDesktop As IActiveDesktop

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        CoCreateInstance(CLSID_ActiveDesktop, _
        IntPtr.Zero, CLSCTX_INPROC_SERVER, _
        IID_IActiveDesktop, ActiveDesktop)

    End Sub
    Private Sub Form1_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
        If SUCCEEDED(ActiveDesktop) Then
            Marshal.ReleaseComObject(ActiveDesktop)
        End If
    End Sub

    Private Function SUCCEEDED(ByVal obj As Object) As Boolean
        '/// checks to see if an object is created or " Nothing "
        If Not obj Is Nothing Then
            Return True
        Else
            Return False
        End If
    End Function

    Private Function makethumb() As Boolean
        Return False
    End Function

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        If SUCCEEDED(ActiveDesktop) Then
            Dim sBuilder As New StringBuilder(_win32.MAX_PATH)
            ActiveDesktop.GetWallpaper(sBuilder, sBuilder.Capacity, 0)
            Label1.Text = sBuilder.ToString
            '/// create a thumbnail image of your current wallpaper and display in a picturebox.
            Dim imgCallback As New Image.GetThumbnailImageAbort(AddressOf makethumb)
            Dim bmp As Bitmap = Bitmap.FromFile(Label1.Text)
            Dim imgThumb As Image = bmp.GetThumbnailImage((PictureBox1.Width / bmp.Width) * bmp.Width, (PictureBox1.Height / bmp.Height) * bmp.Height, imgCallback, IntPtr.Zero)
            PictureBox1.Image = imgThumb
        End If
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        If SUCCEEDED(ActiveDesktop) Then
            Dim OD As New OpenFileDialog
            With OD
                .InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.MyPictures)
                .Filter = "Jpeg |*.jpg|Bitmap |*.bmp"
                If .ShowDialog = DialogResult.OK Then
                    ActiveDesktop.SetWallpaper(OD.FileName, 0)
                    ActiveDesktop.ApplyChanges(_win32.AD_APPLY_FORCE Or _win32.AD_APPLY_SAVE Or _win32.AD_APPLY_REFRESH)
                End If
            End With
        End If
    End Sub

End Class
 #region IActiveDesktop Interface
 
<ComImport(), Guid("F490EB00-1240-11D1-9888-006097DEACF9"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Public Interface IActiveDesktop
    Function ApplyChanges(ByVal dwFlags As Integer) As IntPtr
    '///HRESULT ApplyChanges(DWORD dwFlags);
    Function GetWallpaper( ByVal pwszWallpaper As System.Text.StringBuilder, ByVal cchWallpaper As Integer, ByVal dwReserved As Integer) As IntPtr
    '///HRESULT GetWallpaper(LPWSTR pwszWallpaper,UINT cchWallpaper,DWORD dwReserved);
    Function SetWallpaper( ByVal pwszWallpaper As String, ByVal dwReserved As Integer) As IntPtr
    '///HRESULT SetWallpaper(LPCWSTR pwszWallpaper,DWORD dwReserved);
    Function GetWallpaperOptions(ByRef pwpo As _win32._tagWALLPAPEROPT, ByVal dwReserved As Integer) As IntPtr
    '///HRESULT GetWallpaperOptions(LPWALLPAPEROPT pwpo,DWORD dwReserved);
    Function SetWallpaperOptions(<[In]()> ByRef pwpo As _win32._tagWALLPAPEROPT, ByVal dwReserved As Integer) As IntPtr
    '///HRESULT SetWallpaperOptions(LPCWALLPAPEROPT pwpo,DWORD dwReserved);
    Function GetPattern( ByVal pwszPattern As System.Text.StringBuilder, ByVal cchPattern As Integer, ByVal dwReserved As Integer) As IntPtr
    'HRESULT GetPattern(LPWSTR pwszPattern,UINT cchPattern,DWORD dwReserved);
    Function SetPattern( ByVal pwszPattern As String, ByVal dwReserved As Integer) As IntPtr
    '///HRESULT SetPattern(LPCWSTR pwszPattern,DWORD dwReserved);
    Function GetDesktopItemOptions(ByRef pco As _win32._tagCOMPONENTSOPT, ByVal dwReserved As Integer) As IntPtr
    '///HRESULT GetDesktopItemOptions(LPCOMPONENTSOPT pco,DWORD dwReserved);
    Function SetDesktopItemOptions(<[In]()> ByRef pcomp As _win32._tagCOMPONENTSOPT, ByVal dwReserved As Integer) As IntPtr
    '///HRESULT SetDesktopItemOptions(LPCCOMPONENTSOPT pcomp,DWORD dwReserved);
    Function AddDesktopItem(<[In]()> ByRef pcomp As _win32._tagCOMPONENT, ByVal dwReserved As Integer) As IntPtr
    '///HRESULT AddDesktopItem(LPCOMPONENT pcomp,DWORD dwReserved);
    Function AddDesktopItemWithUI(ByVal hwnd As IntPtr, <[In]()> ByRef pcomp As _win32._tagCOMPONENT, ByVal dwFlags As Integer) As IntPtr
    '///HRESULT AddDesktopItemWithUI(HWND hwnd,LPCOMPONENT pcomp,DWORD dwFlags);
    Function ModifyDesktopItem(<[In]()> ByRef pcomp As _win32._tagCOMPONENT, ByVal dwFlags As Integer) As IntPtr
    '///HRESULT ModifyDesktopItem(LPCCOMPONENT pcomp,DWORD dwFlags);
    Function RemoveDesktopItem(<[In]()> ByRef pcomp As _win32._tagCOMPONENT, ByVal dwReserved As Integer) As IntPtr
    '///HRESULT RemoveDesktopItem(LPCCOMPONENT pcomp,DWORD dwReserved);
    Function GetDesktopItemCount(ByRef lpiCount As Integer, ByVal dwReserved As Integer) As IntPtr
    '///HRESULT GetDesktopItemCount(LPINT lpiCount,DWORD dwReserved);
    Function GetDesktopItem(ByVal nComponent As Integer, ByRef pcomp As _win32._tagCOMPONENT, ByVal dwReserved As Integer) As IntPtr
    '///HRESULT GetDesktopItem(int nComponent,LPCOMPONENT pcomp,DWORD dwReserved);
    Function GetDesktopItemByID(ByVal dwID As IntPtr, ByRef pcomp As _win32._tagCOMPONENT, ByVal dwReserved As Integer) As IntPtr
    '///HRESULT GetDesktopItemByID(DWORD dwID,LPCOMPONENT pcomp,DWORD dwReserved);
    Function GenerateDesktopItemHtml( ByVal pwszFileName As String, <[In]()> ByRef pcomp As _win32._tagCOMPPOS, ByVal dwReserved As Integer) As IntPtr
    '///HRESULT GenerateDesktopItemHtml(LPCWSTR pwszFileName,LPCOMPONENT pcomp,DWORD dwReserved);
    Function AddUrl(ByVal hwnd As IntPtr,  ByVal pszSource As String, <[In]()> ByRef pcomp As _win32._tagCOMPONENT, ByVal dwFlags As Integer) As IntPtr
    '///HRESULT AddUrl(HWND hwnd,LPCWSTR pszSource,LPCOMPONENT pcomp,DWORD dwFlags);
    Function GetDesktopItemBySource( ByVal pszSource As String, ByRef pcomp As _win32._tagCOMPONENT, ByVal dwReserved As Integer) As IntPtr
    '///HRESULT GetDesktopItemBySource(LPCWSTR pszSource,LPCOMPONENT pcomp,DWORD dwReserved);
End Interface
#End Region
 #region win32 constants / structures
 
Public Class _win32
    Public Const AD_APPLY_ALL As Integer = AD_APPLY_SAVE Or AD_APPLY_HTMLGEN Or AD_APPLY_REFRESH
    Public Const AD_APPLY_BUFFERED_REFRESH As Integer = &H10
    Public Const AD_APPLY_DYNAMICREFRESH As Integer = &H20
    Public Const AD_APPLY_FORCE As Integer = &H8
    Public Const AD_APPLY_HTMLGEN As Integer = &H2
    Public Const AD_APPLY_REFRESH As Integer = &H4
    Public Const AD_APPLY_SAVE As Integer = &H1
    Public Const COMP_ELEM_ALL As Integer = COMP_ELEM_TYPE Or COMP_ELEM_CHECKED Or COMP_ELEM_DIRTY Or COMP_ELEM_NOSCROLL Or COMP_ELEM_POS_LEFT Or COMP_ELEM_SIZE_WIDTH Or COMP_ELEM_SIZE_HEIGHT Or COMP_ELEM_POS_ZINDEX Or COMP_ELEM_SOURCE Or COMP_ELEM_FRIENDLYNAME Or COMP_ELEM_POS_TOP Or COMP_ELEM_SUBSCRIBEDURL Or COMP_ELEM_ORIGINAL_CSI Or COMP_ELEM_RESTORED_CSI Or COMP_ELEM_CURITEMSTATE
    Public Const COMP_ELEM_CHECKED As Integer = &H2
    Public Const COMP_ELEM_CURITEMSTATE As Integer = &H4000
    Public Const COMP_ELEM_DIRTY As Integer = &H4
    Public Const COMP_ELEM_FRIENDLYNAME As Integer = &H400
    Public Const COMP_ELEM_NOSCROLL As Integer = &H8
    Public Const COMP_ELEM_ORIGINAL_CSI As Integer = &H1000
    Public Const COMP_ELEM_POS_LEFT As Integer = &H10
    Public Const COMP_ELEM_POS_TOP As Integer = &H20
    Public Const COMP_ELEM_POS_ZINDEX As Integer = &H100
    Public Const COMP_ELEM_RESTORED_CSI As Integer = &H2000
    Public Const COMP_ELEM_SIZE_HEIGHT As Integer = &H80
    Public Const COMP_ELEM_SIZE_WIDTH As Integer = &H40
    Public Const COMP_ELEM_SOURCE As Integer = &H200
    Public Const COMP_ELEM_TYPE As Integer = &H1
    Public Const COMP_ELEM_SUBSCRIBEDURL As Integer = &H800
    Public Const COMP_TYPE_CONTROL As Integer = 3
    Public Const COMP_TYPE_HTMLDOC As Integer = 0
    Public Const COMP_TYPE_PICTURE As Integer = 1
    Public Const COMP_TYPE_WEBSITE As Integer = 2
    Public Const COMPONENT_DEFAULT_LEFT As Integer = &HFFFF
    Public Const COMPONENT_DEFAULT_TOP As Integer = &HFFFF
    Public Const IS_FULLSCREEN As Integer = &H2
    Public Const IS_NORMAL As Integer = &H1
    Public Const IS_SPLIT As Integer = &H4
    Public Const MAX_PATH As Integer = 260
    Public Const WPSTYLE_CENTER As Integer = 0
    Public Const WPSTYLE_MAX As Integer = 3
    Public Const WPSTYLE_STRETCH As Integer = 2
    Public Const WPSTYLE_TILE As Integer = 1

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure _tagCOMPSTATEINFO
        Private dwSize As Integer
        Private iLeft As Integer
        Private iTop As Integer
        Private dwWidth As Integer
        Private dwHeight As Integer
        Private dwItemState As Integer
    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure _tagCOMPPOS
        Private dwSize As Integer
        Private iLeft As Integer
        Private iTop As Integer
        Private dwWidth As Integer
        Private dwHeight As Integer
        Private izIndex As Integer
        <MarshalAs(UnmanagedType.Bool)> _
        Private fCanResize As Boolean
        <MarshalAs(UnmanagedType.Bool)> _
        Private fCanResizeX As Boolean
        <MarshalAs(UnmanagedType.Bool)> _
        Private fCanResizeY As Boolean
        Private iPreferredLeftPercent As Integer
        Private iPreferredTopPercent As Integer
    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure _tagCOMPONENT
        Public dwSize As Integer
        Public dwID As Integer
        Public iComponentType As Integer
        <MarshalAs(UnmanagedType.Bool)> _
        Public fChecked As Boolean
        <MarshalAs(UnmanagedType.Bool)> _
        Public fDirty As Boolean
        <MarshalAs(UnmanagedType.Bool)> _
        Public fNoScroll As Boolean
        Public cpPos As _tagCOMPPOS
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=MAX_PATH)> _
        Public wszFriendlyName As String
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=2084)> _
        Public wszSource As String
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=2084)> _
        Public wszSubscribedURL As String
        Public dwCurItemState As Integer
        Public csiOriginal As _tagCOMPSTATEINFO
        Public csiRestored As _tagCOMPSTATEINFO
    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure _tagCOMPONENTSOPT
        Public dwSize As Integer
        <MarshalAs(UnmanagedType.Bool)> _
        Public fEnableComponents As Boolean
        <MarshalAs(UnmanagedType.Bool)> _
        Public fActiveDesktop As Boolean
    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure _tagWALLPAPEROPT
        Public dwSize As Integer
        Public dwStyle As Integer
    End Structure
End Class
#End Region