如果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
就是这样。