|
|
|
| Title | Randomly change the desktop background in Visual Basic 2005 |
|---|
| Description | This example shows how to randomly change the desktop background in Visual Basic 2005. |
|---|
| Keywords | backer, desktop, background, Registry, default editor, wallpaper, wastebasket, recycle, ShellExecute, SHFileOperation, RegOpenKeyEx, RegSetValueExA, wallpaper style, centered, tiled, stretched |
|---|
| Categories | Windows, Files and Directories, Miscellany |
|---|
|
|
|
This example demonstrates many useful techniques including:
- Picking a file from a random list.
- Setting the desktop wallpaper.
- Setting the desktop wallpaper style (centered, tiled, or stretched).
- Writing Registry entries.
- Moving a file into the wastebasket.
- Editing a file with the system's default editor.
When the program starts, it calls subroutine RestorePosition. That routine restores the form's Left, Top, Width, and Height properties. It also restores the form's WindowState (minimized, maximized, or normal).
|
|
' Restore the form's size and position.
Private Sub RestorePosition(ByVal frm As Form, ByVal _
app_name As String)
frm.SetBounds( _
GetSetting(app_name, "Geometry", "Left", _
Me.RestoreBounds.Left), _
GetSetting(app_name, "Geometry", "Top", _
Me.RestoreBounds.Top), _
GetSetting(app_name, "Geometry", "Width", _
Me.RestoreBounds.Width), _
GetSetting(app_name, "Geometry", "Height", _
Me.RestoreBounds.Height) _
)
frm.WindowState = GetSetting(app_name, "Geometry", _
"WindowState", Me.WindowState)
End Sub
|
|
|
When the program ends, it calls subroutine SavePosition to save those properties. If the form is not currently displayed normally, it saves the form's restores bounds rather than its current bounds.
|
|
' Save the form's size and position.
Private Sub SavePosition(ByVal frm As Form, ByVal app_name _
As String)
SaveSetting(app_name, "Geometry", "WindowState", _
frm.WindowState)
If frm.WindowState = FormWindowState.Normal Then
SaveSetting(app_name, "Geometry", "Left", frm.Left)
SaveSetting(app_name, "Geometry", "Top", frm.Top)
SaveSetting(app_name, "Geometry", "Width", _
frm.Width)
SaveSetting(app_name, "Geometry", "Height", _
frm.Height)
Else
SaveSetting(app_name, "Geometry", "Left", _
frm.RestoreBounds.Left)
SaveSetting(app_name, "Geometry", "Top", _
frm.RestoreBounds.Top)
SaveSetting(app_name, "Geometry", "Width", _
frm.RestoreBounds.Width)
SaveSetting(app_name, "Geometry", "Height", _
frm.RestoreBounds.Height)
End If
End Sub
|
|
|
After restoring its position, the program uses GetSetting to restore control settings such as the directories where the program finds its picture files and the desktop wallpaper style (centered, tiled, or stretched). It uses SaveSetting to save those values when it ends.
The program also calls subroutine MakeButtonTransparent when it starts to give some buttons transparent backgrounds. It calls the MakeTransparent method for the bitmaps displayed on those buttons. It makes pixels with the same color as the upper-left pixel transparent.
|
|
' Give the button a transparent background.
Private Sub MakeButtonTransparent(ByVal btn As Button)
Dim bm As Bitmap = btn.Image
bm.MakeTransparent(bm.GetPixel(0, 0))
End Sub
|
|
|
The program uses a ListBox to hold directories where it should find picture files. When the user clicks the "+" button by the list, the program displays a Folder Selection Dialog to let the user add a new folder to the list.
|
|
Private Sub btnAddDirectory_Click(ByVal sender As _
System.Object, ByVal e As System.EventArgs) Handles _
btnAddDirectory.Click
If fbdDirectory.ShowDialog() = _
Windows.Forms.DialogResult.OK Then
lstDirectories.Items.Add(fbdDirectory.SelectedPath)
btnApplyChanges.Enabled = True
End If
End Sub
|
|
|
When the user clicks the "x" button next to the directory list, the program removes the currently selected directory from the list.
|
|
Private Sub btnRemoveDirectory_Click(ByVal sender As _
System.Object, ByVal e As System.EventArgs) Handles _
btnRemoveDirectory.Click
If lstDirectories.SelectedIndex < 0 Then
btnRemoveDirectory.Enabled = False
Exit Sub
End If
lstDirectories.Items.RemoveAt(lstDirectories.SelectedIndex)
btnApplyChanges.Enabled = True
End Sub
|
|
|
Any time you make a change (remove a directory, change the wallpaper style, and so forth), the program enables its Apply button. When you click that button, the program executes subroutine ApplyChanges. That routine reads the current settings, calls LoadFileList to reload the list of files from the directories, and calls SaveConfig to save the new settings in the Registry.
|
|
Private Sub ApplyChanges()
' Get the new interval.
Dim pause As Integer = Val(txtNumSeconds.Text)
If pause < 1 Then
pause = 1
txtNumSeconds.Text = pause.ToString()
End If
' Reset the timer.
tmrNewPicture.Interval = pause * 1000
tmrNewPicture.Enabled = False
tmrNewPicture.Enabled = True
' Get the new update flag.
m_UpdateRegistry = chkUpdateRegistry.Checked
' Get the new display style.
m_DisplayStyle = cboStyle.Text
' Load the list of files.
LoadFileList()
' Save the settings.
SaveConfig()
' Disable the Apply button again.
btnApplyChanges.Enabled = False
End Sub
|
|
|
Subroutine LoadFileList loops through the directories in the program's list box. For each directory, it adds the image files in the directory to the m_FileNames collection. The subroutine does some extra work to remove any directories that don't exist from the list.
|
|
Private Sub LoadFileList()
m_FileNames = New Collection
Dim dir_names As New Collection
For i As Integer = 0 To lstDirectories.Items.Count - 1
' Make sure the directory exists.
Dim dir_name As String = lstDirectories.Items(i)
If My.Computer.FileSystem.DirectoryExists(dir_name) _
Then
dir_names.Add(dir_name)
' Get the files in the directory.
Dim dir_info As New _
System.IO.DirectoryInfo(dir_name)
Dim files() As FileInfo = _
dir_info.GetFiles("*.*", _
SearchOption.TopDirectoryOnly)
For Each file_info As FileInfo In files
Select Case file_info.Extension.ToLower()
Case ".bmp", ".jpg", ".jpeg", ".gif", _
".png"
m_FileNames.Add(file_info.FullName)
End Select
Next file_info
End If
Next i
lblNumFiles.Text = m_FileNames.Count.ToString() & " " & _
"files"
' Rebuild the directory list.
lstDirectories.Items.Clear()
For i As Integer = 1 To dir_names.Count
lstDirectories.Items.Add(dir_names(i))
Next i
lstDirectories.SelectedIndex = -1
lstDirectories_SelectedIndexChanged(Nothing, Nothing)
' Display a picture.
tmrNewPicture.Enabled = False
tmrNewPicture.Enabled = True
tmrNewPicture_Tick(Nothing, Nothing)
End Sub
|
|
|
When it's time to display a new picture, the program calls DisplayPicture. This routine sets Registry values to indicate the desired wallpaper style (centered, tiled, or stretched). It then loads a random image into a Bitmap, saves the Bitmap into a bitmap file, and uses the SystemParametersInfo API function to set the desktop wallpaper.
|
|
Private Sub DisplayPicture(ByVal file_name As String)
txtCurrentFile.Text = file_name
Try
' Set the proper display style.
Dim key As RegistryKey = _
Registry.CurrentUser.OpenSubKey("Control " & _
"Panel\Desktop", True)
Const STYLE_CENTERED As String = "0"
Const STYLE_TILED As String = "1"
Const STYLE_STRETCHED As String = "2"
Const TILE_NO As String = "0"
Const TILE_YES As String = "1"
Select Case m_DisplayStyle
Case "Stretched"
key.SetValue("TileWallpaper", TILE_NO)
key.SetValue("WallpaperStyle", _
STYLE_STRETCHED)
Case "Tiled"
key.SetValue("TileWallpaper", TILE_YES)
key.SetValue("WallpaperStyle", STYLE_TILED)
Case "Centered"
key.SetValue("TileWallpaper", TILE_NO)
key.SetValue("WallpaperStyle", _
STYLE_CENTERED)
End Select
' Load the file.
Dim bm1 As New Bitmap(file_name)
Dim bm As New Bitmap(bm1)
bm1.Dispose()
' Save the image into a temporary bitmap file.
Dim temp_dir As String = _
System.IO.Path.GetTempPath()
Dim temp_file As String = temp_dir & _
"backer_temp.bmp"
bm.Save(temp_file, _
System.Drawing.Imaging.ImageFormat.Bmp)
' Set the desktop background to this file.
If m_UpdateRegistry Then
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, _
temp_file, SPIF_UPDATEINIFILE Or _
SPIF_SENDWININICHANGE)
Else
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, _
temp_file, 0)
End If
Catch ex As Exception
MessageBox.Show("Error displaying picture " & _
file_name & "." & vbCrLf & ex.Message, _
"Error", MessageBoxButtons.OK, _
MessageBoxIcon.Exclamation)
End Try
End Sub
|
|
|
When the user clicks the Next button, the program calls the timer's Click event handler to display the next picture.
|
|
Private Sub btnNextPicture_Click(ByVal sender As _
System.Object, ByVal e As System.EventArgs) Handles _
btnNextPicture.Click
Me.Cursor = Cursors.WaitCursor
Me.Refresh()
tmrNewPicture_Tick(Nothing, Nothing)
Me.Cursor = Cursors.Default
End Sub
|
|
|
When you click the Edit file, the program opens the current picture file in its default editor. (You may need to change the default editor to Paint or some other drawing program because the editor for some types of image files defaults to the fax viewer.)
|
|
Private Sub btnEditPicture_Click(ByVal sender As _
System.Object, ByVal e As System.EventArgs) Handles _
btnEditPicture.Click
System.Diagnostics.Process.Start(txtCurrentFile.Text)
' Reset the timer.
tmrNewPicture.Enabled = False
tmrNewPicture.Enabled = True
End Sub
|
|
|
When you click the Reload button, the program redisplays the current picture. This is useful if you have edited the file.
|
|
Private Sub btnReloadPicture_Click(ByVal sender As _
System.Object, ByVal e As System.EventArgs) Handles _
btnReloadPicture.Click
Me.Cursor = Cursors.WaitCursor
Me.Refresh()
DisplayPicture(txtCurrentFile.Text)
Me.Cursor = Cursors.Default
End Sub
|
|
|
When you click the Move button (a little arrow next to the current file name), the program displays a Save File Dialog. If you pick a new location and click OK, the program moves the current file
to the new location.
|
|
Private Sub btnMoveFile_Click(ByVal sender As _
System.Object, ByVal e As System.EventArgs) Handles _
btnMoveFile.Click
Dim file_name As String = txtCurrentFile.Text
Try
' Let the user pick a new file name.
Dim file_info As New FileInfo(file_name)
sfdPicture.FileName = file_info.Name
If sfdPicture.ShowDialog() = _
Windows.Forms.DialogResult.OK Then
My.Computer.FileSystem.MoveFile(file_name, _
sfdPicture.FileName)
' Reload the file list.
LoadFileList()
End If
Catch ex As Exception
MessageBox.Show("Error moving picture file " & _
file_name & "." & vbCrLf & ex.Message, _
"Error", MessageBoxButtons.OK, _
MessageBoxIcon.Exclamation)
End Try
End Sub
|
|
|
When you click the Delete button (an "x" next to the current file name), the program uses My.Computer.FileSystem.DeleteFile to move the file into the wastebasket. Note that this call throws an error if the user cancels the deletion (kind of stupid, I know) so the program must be ready to xcatch it.
|
|
' Delete the current file.
Private Sub btnDeleteFile_Click(ByVal sender As _
System.Object, ByVal e As System.EventArgs) Handles _
btnDeleteFile.Click
Dim file_name As String = txtCurrentFile.Text
Try
My.Computer.FileSystem.DeleteFile(file_name, _
FileIO.UIOption.AllDialogs, _
FileIO.RecycleOption.SendToRecycleBin)
' If we deleted the file, reload the file list.
LoadFileList()
Catch ex As OperationCanceledException
Catch ex As Exception
MessageBox.Show("Error deleting picture file " & _
file_name & "." & vbCrLf & ex.Message, _
"Error", MessageBoxButtons.OK, _
MessageBoxIcon.Exclamation)
End Try
End Sub
|
| |
|
| |
|
|
