How to set Wallpaper style (Fill, stretch) accordi

2019-04-14 11:30发布

I am trying to make a wallpaper style stretched if Windows version is Vista, and Fill in case of windows 7, in VB.NET. I got the program to change a Wallpaper , but Im having a problem with applying a style. ( Program consists of a browse button, picture box and Apply button). Your help would be appreciated. Here is the code :

    Imports System.IO
    Imports Microsoft.Win32
    Imports System.Environment
    Imports System.Drawing.Imaging
    Imports System.ComponentModel
    Imports System.Runtime.InteropServices

    Public Class Form1

    Private Property c As Object

    Private Declare Auto Function SystemParametersInfo Lib "user32.dll" (ByVal 
    As Integer, ByVal lpvParam As String, ByVal fuWinIni As Integer) As Integer

    Public Shared Sub SetWallpaper(ByVal Wallpaper As Object, ByVal style As WallpaperStyle)

        Dim Background As System.Drawing.Image = Nothing
        If TypeOf Wallpaper Is String Then
            Background = System.Drawing.Image.FromFile(Wallpaper)
        ElseIf TypeOf Wallpaper Is Image Then
            Background = Wallpaper

        Else
            Exit Sub
        End If

        Dim Location As String = Environment.SystemDirectory & "\CurrentWallpaper.Bmp"

        Background.Save(Location, System.Drawing.Imaging.ImageFormat.Bmp)
        SystemParametersInfo(&H14, 0, Location, &H1 Or &H2)



        Dim key As RegistryKey = Registry.CurrentUser.OpenSubKey("Control Panel\Desktop", True)


        Select Case style
            Case WallpaperStyle.Tile
                key.SetValue("WallpaperStyle", "0")
                key.SetValue("TileWallpaper", "1")
                Exit Select
            Case WallpaperStyle.Center
                key.SetValue("WallpaperStyle", "0")
                key.SetValue("TileWallpaper", "0")
                Exit Select
            Case WallpaperStyle.Stretch
                key.SetValue("WallpaperStyle", "2")
                key.SetValue("TileWallpaper", "0")
                Exit Select
            Case WallpaperStyle.Fit ' (Windows 7 and later)
                key.SetValue("WallpaperStyle", "6")
                key.SetValue("TileWallpaper", "0")
                Exit Select
            Case WallpaperStyle.Fill ' (Windows 7 and later)
                key.SetValue("WallpaperStyle", "10")
                key.SetValue("TileWallpaper", "0")
                Exit Select
        End Select



        key.Close()

    End Sub

    Private ReadOnly Property SelectedWallpaperStyle() As WallpaperStyle

        Get
            If (Environment.OSVersion.Version >= New Version(6, 1)) Then
                Return WallpaperStyle.Fill

            Else : Return WallpaperStyle.Stretch

            End If

        End Get

    End Property



        Private Sub Button1_Click(sender As System.Object, e As                                                                                               System.EventArgs)Handles              Button1.Click   'Browse button

        Dim res As DialogResult

        OpenFileDialog1.Filter = "Picture files (*.bmp .jpg .gif) |*.bmp;*.jpg;*.gif"

        OpenFileDialog1.InitialDirectory = path
        res = OpenFileDialog1.ShowDialog


        If res = Windows.Forms.DialogResult.OK Then
            PictureBox1.Image = Image.FromFile(OpenFileDialog1.FileName)
            TextBox1.Text = OpenFileDialog1.FileName

        End If

    End Sub

    Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles               Button2.Click 'Apply button

        SetWallpaper(OpenFileDialog1.FileName, SelectedWallpaperStyle())

    End Sub

EDIT : I found the solution.I went a slightly different way.( i found a similar example on the net.) I have a main form , and i added a new class called : wallpaper.vb the code in wallpaper.vb goes :

Imports Microsoft.Win32
Imports System.Environment
Imports System.Drawing.Imaging
Imports System.ComponentModel
Imports System.Runtime.InteropServices


Public Class Wallpaper

    ' determine if jpg is supported by OS

    Public Shared ReadOnly Property SupportJpgAsWallpaper()
        Get
            Return (Environment.OSVersion.Version >= New Version(6, 0))
        End Get
    End Property

    ' determine if fit and fill are supported by OS
    Public Shared ReadOnly Property SupportFitFillWallpaperStyles()
        Get
            Return (Environment.OSVersion.Version >= New Version(6, 1))
        End Get
    End Property


    '  SETTING THE WALLPAPER
    Public Shared Sub SetDesktopWallpaper(ByVal path As String, ByVal style As WallpaperStyle)

        ' Set the wallpaper style and tile. 
        ' Two registry values are set in the Control Panel\Desktop key.
        ' TileWallpaper
        '  0: The wallpaper picture should not be tiled 
        '  1: The wallpaper picture should be tiled 
        ' WallpaperStyle
        '  0:  The image is centered if TileWallpaper=0 or tiled if TileWallpaper=1
        '  2:  The image is stretched to fill the screen
        '  6:  The image is resized to fit the screen while maintaining the aspect 
        '      ratio. (Windows 7 and later)
        '  10: The image is resized and cropped to fill the screen while 
        '      maintaining the aspect ratio. (Windows 7 and later)
        Dim key As RegistryKey = Registry.CurrentUser.OpenSubKey("Control Panel\Desktop", True)

        Select Case style
            Case WallpaperStyle.Tile
                key.SetValue("WallpaperStyle", "0")
                key.SetValue("TileWallpaper", "1")
                Exit Select
            Case WallpaperStyle.Center
                key.SetValue("WallpaperStyle", "0")
                key.SetValue("TileWallpaper", "0")
                Exit Select
            Case WallpaperStyle.Stretch
                key.SetValue("WallpaperStyle", "2")
                key.SetValue("TileWallpaper", "0")
                Exit Select
            Case WallpaperStyle.Fit ' (Windows 7 and later)
                key.SetValue("WallpaperStyle", "6")
                key.SetValue("TileWallpaper", "0")
                Exit Select
            Case WallpaperStyle.Fill ' (Windows 7 and later)
                key.SetValue("WallpaperStyle", "10")
                key.SetValue("TileWallpaper", "0")
                Exit Select
        End Select

        key.Close()

        ' is jpg and bmp are supported

        Dim ext As String = System.IO.Path.GetExtension(path)
        If ((Not ext.Equals(".bmp", StringComparison.OrdinalIgnoreCase) AndAlso _
             Not ext.Equals(".jpg", StringComparison.OrdinalIgnoreCase)) _
            OrElse _
            (ext.Equals(".jpg", StringComparison.OrdinalIgnoreCase) AndAlso _
            (Not SupportJpgAsWallpaper))) Then

            Using image As Image = image.FromFile(path)
                path = String.Format("{0}\Microsoft\Windows\Themes\{1}.bmp", _
                    Environment.GetFolderPath(SpecialFolder.ApplicationData), _
                    System.IO.Path.GetFileNameWithoutExtension(path))
                image.Save(path, ImageFormat.Bmp)
            End Using

        End If


        If Not Wallpaper.SystemParametersInfo(20, 0, path, 3) Then
            Try

            Catch ex As Exception

            End Try

        End If
    End Sub


    <DllImport("user32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)> _
    Private Shared Function SystemParametersInfo( _
        ByVal uiAction As UInt32, _
        ByVal uiParam As UInt32, _
        ByVal pvParam As String, _
        ByVal fWinIni As UInt32) _
        As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function

    Private Const SPI_SETDESKWALLPAPER As UInt32 = 20
    Private Const SPIF_SENDWININICHANGE As UInt32 = 2
    Private Const SPIF_UPDATEINIFILE As UInt32 = 1
End Class


Public Enum WallpaperStyle
    Tile
    Center
    Stretch
    Fit
    Fill
End Enum

and then in the mainform (mainform vb) in button1 (which sets the wallpaper if clicked) added the following code which has the selected wallpaper style:

 Private Sub btnSetWallpaper_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
    Handles btnSetWallpaper.Click

        Dim pozadina As String = OpenFileDialog1.FileName
        If Not String.IsNullOrEmpty(Me.wallpaperFileName) And textbox1.Text = pozadina Then
            Wallpaper.SetDesktopWallpaper(Me.wallpaperFileName, Me.SelectedWallpaperStyle)

        End If

End Sub

thats it.

0条回答
登录 后发表回答