如果 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 的主窗体（主窗体 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
而已。