如何根据Windows版本设置壁纸样式(填充,拉伸)

时间:2013-11-14 22:36:59

标签: vb.net windows styles version wallpaper

如果Windows版本是Vista,我试图让壁纸风格延伸, 并在VB.NET中填写Windows 7的情况。我得到了改变壁纸的程序,但是我在应用样式方面遇到了问题。 (程序包括浏览按钮,图片框和应用按钮)。 非常感谢您的帮助。 这是代码:

    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
编辑:我找到了解决方案。我的方式略有不同。(我在网上找到了类似的例子。) 我有一个主要表单,我添加了一个名为:wallpaper.vb的新类 wallpaper.vb中的代码为:

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

然后在button1中的mainform(mainform vb)中(如果单击则设置壁纸)添加了以下具有所选壁纸样式的代码:

 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

就是这样。

0 个答案:

没有答案