My study of Visual Basic .NET continues...
I decided to write a program to cycle the background on my computer. This is of course redundant now that I have Windows 7 but it works best if you have some target, rather than just trying to learn the whole thing at once. My next project is going to be a tool for keeping track of PCs and related equipment in the offices I work in. I have different systems I’ve inherited and none which take care of everything I need or want to know about the assets. As I discovered, lots of people do it when they're learning VB but that helps when you're trying to figure it out. It only works with bitmaps due to a limitation of the Windows API but it does what it does well and I've learned a lot which was my original intention. First you select the folder with bitmaps in. The program chooses one and sets up the system to change it every boot.
Download it if you like. 
(330KB .msi file, 10th September 2008)
Download it or run it from here, it's straightforward. You'll need
.Net to make it work, it should install
if you don't have it. If you want to make your own wallpaper changing
button, copy the Test shortcut.
Bug: it doesn't work if you hide your desktop icons. I'm working on it.
You could also use these wallpapers. Once you've set it up you can add images to the folder and the program will include them without extra configuration.
The programs look like this at the moment:
Code: 'BackRand Version 2.2 17th September 2008
Imports
System.Runtime.InteropServices 'For APIsImports
Microsoft.Win32 'The Registry stuffImports
System.IO 'File operationsPublic Class BackRand
'Initialise general variables
Dim strChosenFolder As String 'the selected folder variable Dim strChosenFile As String 'File chosen to be current background Dim intChoosingArrayPosn As Integer 'Counter for collecting image files Dim arrChoosingArray() As String 'Array of image files collected from strFilter'Check for Command Line switch "/agent" Private Sub BackRand_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim inputArgument As String = "/agent" 'Template to check against
For Each strArgument As String In My.Application.CommandLineArgs 'Scan through command switches received
If strArgument.ToLower.StartsWith(inputArgument) Then 'If we find the right one If fnReadSettings() Then 'Program checks for folder in registryIf fnDirExists(strChosenFolder) Then 'If the image folder is there
fnGetImages()
'Search the folder for images If intChoosingArrayPosn > 0 Then 'If we found some imagesRandomize()
'Initialise RNDstrChosenFile = strChosenFolder +
"\" + arrChoosingArray(Int(Rnd() * intChoosingArrayPosn)) 'Collate the selected filenamefnSetWall()
' Set the chosen file as the desktop background End 'We're done, exit ElseMsgBox(
"No images in selected folder: " + strChosenFolder, vbOKOnly, "Error") 'Say we couldn't find any End If ElseMsgBox(
"Could not find folder: " + strChosenFolder, vbOKOnly, "Error") 'Say the folder is missing End If End IfEnd If
Next
End Sub
Private Sub Browse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Browse.Click 'User clicks Browse and chooses folder to get images from Dim dlgFolderBrowser As New FolderBrowserDialog 'Set up the FolderBrowserDialog
dlgFolderBrowser.Description =
"Please select a folder for the images." 'Tell the user what the dialog is fordlgFolderBrowser.ShowNewFolderButton =
False 'No New Folder buttondlgFolderBrowser.RootFolder = System.Environment.SpecialFolder.Desktop
dlgFolderBrowser.SelectedPath =
My.Computer.FileSystem.SpecialDirectories.Desktop 'Start in the Desktop folderIf dlgFolderBrowser.ShowDialog = Windows.Forms.DialogResult.OK Then 'If the user clicks the FolderBrowser's OK button.
strChosenFolder = dlgFolderBrowser.SelectedPath
'Set the ChosenFolder to the FolderBrowserDialog's SelectedPath property.End If
Me.FolderChoiceTextBox.Text = strChosenFolder 'Set the FolderChoiceTextBox's Text to the FolderBrowserDialog's SelectedPath property. End Sub
Private Sub OK_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OK.Click 'User clicks OK and Program chooses a file Me.Messages.Text = "" 'Clear the error box
If strChosenFolder = "" Then
strChosenFolder =
Me.FolderChoiceTextBox.TextEnd If
If fnDirExists(strChosenFolder) Then 'If the image folder is there
fnGetImages()
If intChoosingArrayPosn > 0 Then 'If we found some images
Randomize()
'Initialise RNDstrChosenFile = strChosenFolder +
"\" + arrChoosingArray(Int(Rnd() * intChoosingArrayPosn)) 'Collate the randomly selected filenamefnSetWall()
'Set the chosen file as the desktop backgroundfnWriteSettings()
'Save the folder for the agent to use laterfnAddToStartup()
'Create shortcut to bgAgentMsgBox(
"Background copied and set to cycle. Folder is " + strChosenFolder, vbOKOnly, "Confirmation") 'Confirm actionElse
Me.Messages.Text = "ERROR: No BMP files found."
Return 'If there are no files just bounce back
End If
Else
Me.Messages.Text = "ERROR: No valid folder selected."
Return 'If there's no folder just bounce back
End If
End Sub
'Finished
Private Sub Done_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Done.Click
End 'Exit the program
End Sub
'Sets the desktop wallpaper
Public Function fnSetWall()
Dim DWWallKey As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.CurrentUser.OpenSubKey("Control Panel", True) 'Open the Registry key which handles the current wallpaper
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, strChosenFile, SPIF_UPDATEINIFILE)
'Set Parameters To Change The Wallpaper & To Update The Windows SettingDWWallKey = DWWallKey.OpenSubKey(
"Desktop", True) 'Open Wallpaper Registry keyDWWallKey.SetValue(
"Wallpaper", strChosenFile) 'Save New Wallpaper LocationfnSetWall =
TrueEnd Function
'Returns a boolean - True if the folder exists
Public Function fnDirExists(ByVal strFile As String)
Dim fsoFolder
fsoFolder = CreateObject("Scripting.FileSystemObject")
fnDirExists = fsoFolder.folderexists(strFile)
End Function
'Adds the Agent to startup
Public Function fnAddToStartup()
Dim strProgramPath As String
Dim oReg As RegistryKey = Registry.CurrentUser
Dim oKey As RegistryKey = oReg.OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Run", True)
strProgramPath = My.Application.Info.DirectoryPath + "\BackRand.exe /agent"
oKey.SetValue(
"James' Background Swapper", strProgramPath)fnAddToStartup = True
End Function
'Collects list of images
Public Function fnGetImages()
Dim arrAllFiles() As String = Directory.GetFiles(strChosenFolder, "*.bmp") 'Collect files with bmp filter
For Each strFileName As String In arrAllFiles 'Working through the collected files
ReDim Preserve arrChoosingArray(intChoosingArrayPosn) 'Expand array but keep data
arrChoosingArray(intChoosingArrayPosn) = Path.GetFileName(strFileName)
'Put the filename into the arrayintChoosingArrayPosn = intChoosingArrayPosn + 1
'Increment array positionNext
fnGetImages =
TrueEnd Function
'Write the settings
Public Function fnWriteSettings()
Dim strAppName As String
Dim strKeyName As String
strAppName =
"Background Swapper"strKeyName =
"Folder"My.Computer.Registry.CurrentUser.CreateSubKey(strAppName)
My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\" + strAppName, strKeyName, strChosenFolder)
fnWriteSettings = True
End Function
'Gets the key from the registry
Public Function fnReadSettings()
Dim strAppName As String
Dim strKeyName As String
strAppName =
"Background Swapper"strKeyName =
"Folder"fnReadSettings = False
If My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Software\" + strAppName, strKeyName, Nothing) Is Nothing Then
MsgBox(
"Folder selection not found in registry.", vbOKOnly, "Error")Return fnReadSettings
Else
strChosenFolder =
My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Software\" + strAppName, strKeyName, Nothing)End If
fnReadSettings =
TrueReturn fnReadSettings
End Function
'API to set the systems parameters for changing the wallpaper
Private Declare Function SystemParametersInfo Lib "user32" _
Alias "SystemParametersInfoA" _
(ByVal uAction As Integer, _
ByVal uParam As Integer, _
ByVal lpvParam As String, _
ByVal fuWinIni As Integer) As Integer
Private Const SPI_SETDESKWALLPAPER = 20 'Set Wallpaper
Private Const SPIF_UPDATEINIFILE = &H1 'Update The WIN.INI File
End
Class