• 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()
    Loop
    
    NumNames = FileNames.Count
    RandomizeNames
End Sub

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

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
    Else
        SwitchTimer.Interval = 60000
    End If
    SwitchTimer.Enabled = True
End Sub

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
    Else
        HiddenPict.Picture = LoadPicture(m_CurrentFile)
        SavePicture HiddenPict.Picture, DirName & _
            "\temp.bmp"
        SystemParametersInfo SPI_SETDESKWALLPAPER, _
            0, DirName & "\temp.bmp", _
            SPIF_UPDATEINIFILE
    End If
End Sub

Private Sub cmdEdit_Click()
    ShellExecute ByVal 0&, "edit", m_CurrentFile, _
        vbNullString, vbNullString, SW_SHOWMAXIMIZED
End Sub

Private Sub cmdDelete_Click()
    ' Delete the file.
    DeleteFile m_CurrentFile, False

    ' Display the next file.
    cmdNext_Click
End Sub

Public Sub DeleteFile(ByVal file_name As String, ByVal _
    user_confirm As Boolean)
Dim op As SHFILEOPSTRUCT

    With op
        .wFunc = FO_DELETE
        .pFrom = file_name
        If user_confirm Then
            ' Make the user confirm.
            .fFlags = FOF_ALLOWUNDO
        Else
            ' Do not make the user confirm.
            .fFlags = FOF_ALLOWUNDO Or FOF_NOCONFIRMATION
        End If
    End With
    SHFileOperation op
End Sub