What's New
Q & A
Tip Jar
C# Helper...
Follow VBHelper on Twitter
MSDN Visual Basic Community
TitleRandomly change the desktop background in Visual Basic 6
Keywordsbacker, desktop, background, Registry, default editor, wallpaper, wastebasket, recycle, ShellExecute, SHFileOperation, RegOpenKeyEx, RegSetValueExA, wallpaper style, centered, tiled, stretched
CategoriesWindows, 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 (and when you click the Apply button), the program calls ReadFiles. That routine reads the names of the files in the indicated directory and saves those that end in BMP, GIF, JPG, and JPEG. After it loads all the file names, the routine calls RandomizeNames to randomize the list.

Sub ReadFiles()
Dim file As String
Dim ext As String

    ' Create the new file name collection.
    Set FileNames = New Collection
    ' Get the file names.
    file = Dir(DirName & "\*.*")
    Do While file <> ""
        If LCase$(file) <> "temp.bmp" Then
            ext = UCase$(Right$(file, 4))
            If ext = ".BMP" Or ext = ".GIF" Or _
               ext = ".JPG" Or ext = "JPEG" _
               Then _
                    FileNames.Add file
        End If
        file = Dir()
    NumNames = FileNames.Count
End Sub
Subroutine RandomizeNames makes an array of indexes with one entry for each name in the FileNames collection. For i = 1 to NumNames - 1, the routine selects a random index and swaps it into position i.
Private Sub RandomizeNames()
Dim idx As Integer
Dim tmp As Integer
Dim i As Integer

    ReDim Indexes(1 To NumNames)
    For i = 1 To NumNames
        Indexes(i) = i
    Next i

    ' Randomize them.
    For i = 1 To NumNames - 1
        idx = Int((NumNames - i + 1) * Rnd + i)
        tmp = Indexes(i)
        Indexes(i) = Indexes(idx)
        Indexes(idx) = tmp
    Next i
    ' Point to the index to display.
    NextIndex = 1
End Sub
When a Timer fires, the program calls ShowFile to display the next file in the randomized list.
Private Sub SwitchTimer_Timer()
Dim secs As Long
Dim pic As Integer

    ' See if it's time yet.
    secs = DateDiff("s", Now, NextTime)
    If secs <= 1 Then
        If FileNames.Count > 1 Then
            pic = Indexes(NextIndex)
            NextIndex = NextIndex + 1
            If NextIndex > NumNames Then RandomizeNames

            ShowFile FileNames(pic)
        End If
        NextTime = DateAdd("s", Pause, Now)
        secs = Pause
    End If
    If secs <= 60 Then
        SwitchTimer.Interval = secs * 1000
        SwitchTimer.Interval = 60000
    End If
    SwitchTimer.Enabled = True
End Sub
Subroutine ShowFile checks the Style combo box and sets Registry entries to make the desktop image centered, tiled, or stretched.

Next, if the file is a bitmap file, the program simply calls the SystemParametersInfo API function to set the desktop background image.

If the file is not a bitmap file, the program loads it into a hidden PictureBox and then saves the image as a bitmap file. Then it calls SystemParametersInfo.

Private Sub ShowFile(ByVal file_name As String)
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"

Dim had_error As Boolean

    ' Set the display style.
    had_error = False
    Select Case cboStyle.Text
        Case "Centered"
            If SetRegistryValue(HKEY_CURRENT_USER, _
                "Control Panel\Desktop", "TileWallpaper", _
                    TILE_NO) _
                    Then had_error = True
            If SetRegistryValue(HKEY_CURRENT_USER, _
                "Control Panel\Desktop", "WallpaperStyle", _
                    STYLE_CENTERED) _
                    Then had_error = True
        Case "Tiled"
            If SetRegistryValue(HKEY_CURRENT_USER, _
                "Control Panel\Desktop", "TileWallpaper", _
                    TILE_YES) _
                    Then had_error = True
            If SetRegistryValue(HKEY_CURRENT_USER, _
                "Control Panel\Desktop", "WallpaperStyle", _
                    STYLE_TILED) _
                    Then had_error = True
        Case "Stretched"
            If SetRegistryValue(HKEY_CURRENT_USER, _
                "Control Panel\Desktop", "TileWallpaper", _
                    TILE_NO) _
                    Then had_error = True
            If SetRegistryValue(HKEY_CURRENT_USER, _
                "Control Panel\Desktop", "WallpaperStyle", _
                    STYLE_STRETCHED) _
                    Then had_error = True
    End Select
    If had_error Then
        MsgBox "Error saving desktop style to registry.", _
            vbOKOnly, "Registry Error"
    End If

    ' Display the file.
    FileLabel.Caption = file_name
    m_CurrentFile = DirName & "\" & file_name
    If UCase$(Right$(file_name, 4)) = ".BMP" Then
        SystemParametersInfo SPI_SETDESKWALLPAPER, _
            0, m_CurrentFile, SPIF_UPDATEINIFILE
        HiddenPict.Picture = LoadPicture(m_CurrentFile)
        SavePicture HiddenPict.Picture, DirName & _
        SystemParametersInfo SPI_SETDESKWALLPAPER, _
            0, DirName & "\temp.bmp", _
    End If
End Sub
When you click the Edit button, the program uses the ShellExecute API function to edit the current picture file.
Private Sub cmdEdit_Click()
    ShellExecute ByVal 0&, "edit", m_CurrentFile, _
        vbNullString, vbNullString, SW_SHOWMAXIMIZED
End Sub
When you click the Delete button, the program calls subroutine DeleteFile to move the file into the wastebasket. It then displays the next picture.
Private Sub cmdDelete_Click()
    ' Delete the file.
    DeleteFile m_CurrentFile, False

    ' Display the next file.
End Sub
Subroutine DeleteFile uses the SHFileOperation API function to move a file into the wastebasket, optionally asking the user to confirm.
Public Sub DeleteFile(ByVal file_name As String, ByVal _
    user_confirm As Boolean)

    With op
        .wFunc = FO_DELETE
        .pFrom = file_name
        If user_confirm Then
            ' Make the user confirm.
            .fFlags = FOF_ALLOWUNDO
            ' Do not make the user confirm.
        End If
    End With
    SHFileOperation op
End Sub
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.