Click here to Skip to main content
14,303,800 members

Background Tile Creator

Rate this:
4.88 (21 votes)
Please Sign up or sign in to vote.
4.88 (21 votes)
2 Sep 2011CPOL
A small utility for creating interesting background tile images. Includes "Set as Wallpaper" feature

Image 1


First: A recent update had a rather nasty bug that slipped past me. The problem has been eliminated. Apologies to any of you who got a buggy copy of BTC.

Background Tile Creator ("BTC" from here on out) is a simple utility that creates background tile images from existing images. The results can range from beautiful to bizarre depending upon your source image and the selection you make within it. Just open an image, make a selection with the mouse, and the tile is created automatically.

How BTC creates the tile

When you drag a selection on a source image, BTC creates a new blank image twice the size of the selection. The original selection is placed in the top left corner. BTC then flips the selection horizontally and places this image in the top right corner. This second image is then flipped vertically and placed in the lower right corner, and lastly the third image is again flipped horizontally and drawn to the lower left corner.

You can resize the selection by pointing at the appropriate drag handle and dragging it in one direction or another. You can also move the selection rectangle around the source image by pressing the left mouse button inside it. Both the tile and the page background preview can be updated as you draw or move the selection (this is mildly cool to watch). To do this, check the "Update tile during selection" checkbox in the left pane. Note that with selections larger than 100x100, this may adversely affect performance. If you notice the program slowing down during any part of the selection process, just uncheck the checkbox. The tile will then be updated when you release the mouse instead of while dragging it.

You can resize the finished tile with the trackbar controls in the left pane. Checking the "Rotate 90 Deg CW" checkbox rotates the tile 90 degrees clockwise. Given that the image is a tile, further flip/rotate actions have little meaningful effect.

To save your tile, click the Save button in the tool bar. A standard Windows SaveFileDialog will open.

Known issue: When resizing the finished tile to make it larger, fine lines sometimes appear between the individual tiles in the Background Preview tab. This only occurs in the preview. Once an image is saved and used elsewhere, the lines do not appear. I'm still trying to figure out why this happens.

A look at the code...

One reference added: Shell32.dll

BTC Imports the following namespaces:

Imports System.Windows.Forms
Imports System.IO
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Math
Imports System.Runtime.InteropServices
Imports Shell32

Here are the variables and rectangles used throughout the project:

#Region "declarations"
  Friend title As String = "Background Tile Creator"
  Friend imgName As String 'the filename of the src image
  Dim msg As String 'for messages
  Dim x, y, l As Integer 'x&y coords, and width/height values
  Dim WithEvents pntPnl As New PaintPanel

  'sr is the selection rectangle

  'r is used in drawing the source image

  'RectInfo is a rectangle that holds the value of the
  'last instance of the selection rectangle (sr). This
  'is used to properly draw a new instance of sr. You'll
  'see it used in the MouseMove sub.

  Friend r, sr, RectInfo As Rectangle

  'grab-handles for resizing selection
  Dim grabHandles(8) As Rectangle
  Dim curs() As Cursor = {Cursors.SizeNWSE, Cursors.SizeNS, Cursors.SizeNESW, _
             Cursors.SizeWE, Cursors.SizeNWSE, Cursors.SizeNS, _
             Cursors.SizeNESW, Cursors.SizeWE, Cursors.Default}
  Friend grabSize As New Size(6, 6) 'size of grab-handle rects
  Friend grabPen As New Pen(Color.Black, 1) 'grab-handle outline
  Friend grabBrush As New SolidBrush(Color.White) 'grab-handle fill color

  Friend rectPoints As Point 'x-y location of sel rect
  Dim selSize As Size 'size of selection rect

  'these are for drawing the selection rectangle
  Dim myPen As New Pen(Color.White, 1)
  Dim innerBrush As New SolidBrush(Color.FromArgb(60, 0, 0, 255))

  Dim res As DialogResult
  Dim g As Graphics 'draw the original image
  'isDown is true anytime the left mouse button is pressed inside
  'the source image.

  'canResize is true when the mouse button is pressed over an edge 
  'of the selection rectangle. You'll get a double-arrow cursor.

  'canMove is true when the left mouse button is pressed more than
  'two pixels inside the selection rect. This is for moving the
  'selection rectangle around the image.
  Dim isDown, canResize, canMove As Boolean

  'original is a copy of the original image used as a source image.
  'bmp is the "working" image - a copy of the original
  'selBMP is the tile image created when you make a selection
  Friend bmp, original, selBMP As Bitmap

  'for determining resize and moving operations
  'of the selection rectangle (see mousemove event handler)
  Enum CursorPos
    TopLeft = 0
    TopSide = 1
    TopRight = 2
    RightSide = 3
    BottomRight = 4
    BottomSide = 5
    BottomLeft = 6
    LeftSide = 7
    Inside = 8
    NotOnRect = 9
  End Enum
  Dim curPos As CursorPos = CursorPos.NotOnRect

  'false after changes to tile - true when saved
  Dim isSaved As Boolean = False
  'full path of saved tile image
  Friend tilePath As String = String.Empty
  Dim openPath As String

#End Region

A few items to be done when the program loads...

Private Sub LoadApplication() Handles MyBase.Load
    Me.WindowState = FormWindowState.Maximized
    'if My.Settings.RecentFiles contains items, add them to the 
    'Open button's dropdown list
    Dim rf() As String = My.Settings.RecentFiles.Split("|")
    If rf.Length > 0 Then
      For Each s As String In rf
        If File.Exists(s) Then
          tb_Open.DropDown.Items.Add(New ToolStripMenuItem(s))
        End If
    End If
    '--------------End of dropdown list addition---------------
    AddHandler Me.Activated, AddressOf UpdateUI
    myPen.DashStyle = Drawing2D.DashStyle.Dash
    pntPnl.Dock = DockStyle.Fill
End Sub

And when it closes...

Private Sub main_FormClosing (ByVal sender As Object, _
        ByVal e As System.Windows.Forms.FormClosingEventArgs) _
        Handles Me.FormClosing
    'update My.Settings recent items list
    If tb_Open.DropDownItems.Count > 0 Then
      Dim itemStr As String = String.Empty
      For l = 0 To tb_Open.DropDownItems.Count - 1
        If File.Exists(tb_Open.DropDownItems(l).Text) Then
          itemStr &= tb_Open.DropDownItems(l).Text
          If l < tb_Open.DropDownItems.Count - 1 Then
            itemStr &= "|"
          End If
        End If
      My.Settings.RecentFiles = itemStr
    End If
End Sub

To open a source image, click the Open button in the tool bar. It's a SplitButton. Clicking the dropdown reveals the last five source images you've used. Clicking the left side of the button opens an OpenFileDialog.

Private Sub OpenFileFromDialog() Handles tb_Open.ButtonClick
      If Directory.Exists(Path.GetDirectoryName(openPath)) Then
        dialog_Open.InitialDirectory = openPath
        dialog_Open.InitialDirectory = _
      End If
    Catch ex As Exception
      MsgBox(ex.ToString, MsgBoxStyle.Exclamation, title)
      Exit Sub
    End Try

    res = dialog_Open.ShowDialog
    If res = Windows.Forms.DialogResult.OK Then
      Catch ex As Exception
        MsgBox(ex.ToString, MsgBoxStyle.Exclamation, title)
      End Try
    End If
End Sub

'open from recent files list
Private Sub OpenFromList (ByVal sender As Object, _
        ByVal e As System.Windows.Forms.ToolStripItemClickedEventArgs) _
        Handles tb_Open.DropDownItemClicked
      If File.Exists(e.ClickedItem.Text) Then
        MsgBox("The selected file no longer exists." & Chr(10) & _
               "The name has been removed from the list.", _
               MsgBoxStyle.Information, title)
      End If

    Catch ex As Exception
      MsgBox(ex.ToString, MsgBoxStyle.Exclamation, title)
    End Try
End Sub

'this sub uses the value from the subs above to open a source image
Private Sub OpenNewSourceImage(ByVal imgPath As String)
      original = Bitmap.FromFile(imgPath)
      imgName = imgPath
      openPath = imgPath
      r = New Rectangle(0, 0, original.Width, original.Height)
      sr = Nothing
      statLabel_ImgName.Text = imgPath

      'set the picturebox backgroundimage to the source image
      'the selection rect is drawn over the background
      picbox_SrcImage.Size = original.Size
      picbox_SrcImage.BackgroundImage = original
      'clear the tile preview picturebox
      picbox_TilePreview.Image = Nothing
    Catch ex As Exception
      MsgBox(ex.ToString, MsgBoxStyle.Exclamation, title)
    End Try
End Sub

Creating the selection rectangle

As in most graphics apps, a selection rectangle is defined by dragging the mouse across the image. Here's how it works with BTC:

  • When the left mouse button is not pressed:
  • Move the mouse around to position it to draw a selection, or move it over a grab-handle of an existing selection to resize it. Place the mouse inside the selection to move it (the cursor changes to Cursors.SizeAll).

    During the MouseMove event, the canResize and canMove boolean variables are set to True or False. If for example you point the mouse at a grab-handle, the canResize variable is set to True and canMove is set to False.

  • When the left mouse button is pressed:
  • When the left mouse button is pressed over the source image, the isDown boolean variable is set to True. This tells the MouseMove event that a selection is to be drawn, moved, or resized.

    When the MouseDown event occurs, the program acts according to whether one of the boolean values (canMove or canResize) are true when the next MouseMove event occurs.

    If canMove and isDown are both True (the mouse button is pressed and the mouse is hovering inside an existing selection rectangle), then the selection rectangle is dragged when the mouse is moved. If isDown and canResize are both True (the mouse button is pressed and the mouse is hovering over a grab-handle), the selection will be resized when the mouse is moved.

  • When the mouse button is released...
  • When the mouse button is released and the MouseUp event fires, isDown is set to False. While the button is released, you can move the mouse to a different location (over another grab-handle for example) and then press the button again to initiate another move/resize operation.

    Each time the MouseUp event occurs, the program checks to see if a selection rectangle exists. If it does, a new tile is created and displayed.

Note that you can clear the current selection by simply clicking the mouse on the source image.

The MouseDown event handler:

Private Sub picbox_MouseDown(ByVal sender As Object, _
        ByVal e As System.Windows.Forms.MouseEventArgs) _
        Handles picbox_SrcImage.MouseDown
    x = e.X : y = e.Y
    isDown = True
    If e.Button = Windows.Forms.MouseButtons.Left AndAlso _
    Not canResize AndAlso Not canMove Then
      sr.Width = 0
      sr.Height = 0
    End If
End Sub

The MouseUp event handler:

Private Sub picbox_MouseUp (ByVal sender As Object, _
        ByVal e As System.Windows.Forms.MouseEventArgs) _
        Handles picbox_SrcImage.MouseUp
    RectInfo = New Rectangle(sr.Left, sr.Top, sr.Width, sr.Height)
    isDown = False
    canMove = False
    canResize = False
    picbox_SrcImage.Cursor = Cursors.Default
End Sub

The MouseMove event handler...

Private Sub picbox_MouseMove(ByVal sender As Object, _
        ByVal e As System.Windows.Forms.MouseEventArgs) _
        Handles picbox_SrcImage.MouseMove

    If Not original Is Nothing Then
      If e.X < 0 Or e.X > original.Width _
               Or e.Y < 0 Or e.Y > original.Height Then
        Exit Sub
      End If

      If isDown Then 'if left mouse button is down...
        sldr_SizeH.Value = 100
        sldr_SizeW.Value = 100

        'draw new selection rect...
        If Not canResize AndAlso Not canMove Then
          Dim iLeft As Integer = 0
          Dim iTop As Integer = 0
          Dim iRight As Integer = original.Width
          Dim iBtm As Integer = original.Height
            If e.X >= iLeft AndAlso e.X <= iRight _
                      AndAlso e.Y >= iTop AndAlso e.Y <= iBtm Then
              rectPoints = New Point(Min(x, e.X), Min(y, e.Y))
              selSize = New Size(Max(x - e.X, e.X - x), Max(y - e.Y, e.Y - y))

              BuildRects() 'build the selection rect and its resize handles
            End If

          Catch ex As Exception
            MsgBox("Error making selection..." & Chr(10) & ex.ToString)
          End Try

        End If
        '------------------------------End Draw Rect------------------------------

        'Here's where the CurPos enum is used. The math for resizing
        'the selection changes depending upon which side or corner
        'of the rectangle has been selected

        'resize sel rect...
        If canResize Then
          Select Case curPos
            Case CursorPos.BottomSide
              rectPoints = New Point(RectInfo.Left, Min(e.Y, RectInfo.Top))
              selSize = New Size(RectInfo.Width, Max(e.Y - RectInfo.Top, RectInfo.Top - e.Y))

            Case CursorPos.TopSide
              rectPoints = New Point(RectInfo.Left, Min(e.Y, RectInfo.Bottom))
              selSize = New Size(RectInfo.Width, Max(RectInfo.Bottom - e.Y, e.Y - RectInfo.Bottom))

            Case CursorPos.LeftSide
              rectPoints = New Point(Min(e.X, RectInfo.Right), RectInfo.Y)
              selSize = New Size(Max(RectInfo.Right - e.X, e.X - RectInfo.Right), RectInfo.Height)

            Case CursorPos.RightSide
              rectPoints = New Point(Min(e.X, RectInfo.Left), RectInfo.Top)
              selSize = New Size(Max(e.X - RectInfo.X, RectInfo.X - e.X), RectInfo.Height)

            Case CursorPos.BottomRight
              rectPoints = New Point(Min(e.X, RectInfo.Left), Min(e.Y, RectInfo.Top))
              selSize = New Size(Max(e.X - RectInfo.X, RectInfo.X - e.X), _
                        Max(e.Y - RectInfo.Top, RectInfo.Top - e.Y))

            Case CursorPos.BottomLeft
              rectPoints = New Point(Min(e.X, RectInfo.Right), Min(e.Y, RectInfo.Top))
              selSize = New Size(Max(RectInfo.Right - e.X, e.X - RectInfo.Right), _
                        Max(e.Y - RectInfo.Top, RectInfo.Top - e.Y))

            Case CursorPos.TopLeft
              rectPoints = New Point(Min(e.X, RectInfo.Right), Min(e.Y, RectInfo.Bottom))
              selSize = New Size(Max(RectInfo.Right - e.X, e.X - RectInfo.Right), _
                        Max(RectInfo.Bottom - e.Y, e.Y - RectInfo.Bottom))

            Case CursorPos.TopRight
              rectPoints = New Point(Min(e.X, RectInfo.Left), Min(e.Y, RectInfo.Bottom))
              selSize = New Size(Max(e.X - RectInfo.X, RectInfo.X - e.X), _
                        Max(RectInfo.Bottom - e.Y, e.Y - RectInfo.Bottom))

          End Select

        End If
        '------------------------end resize sel rect------------------

        'move sel rect...
        If canMove Then
          Dim offsetX As Integer = x - RectInfo.Left
          Dim offsetY As Integer = y - RectInfo.Top
          If (e.X - offsetX) >= 0 AndAlso ((e.X - offsetX) + _
                RectInfo.Width) <= original.Width AndAlso _
                (e.Y - offsetY) >= 0 AndAlso ((e.Y - offsetY) + _
                RectInfo.Height) <= original.Height Then
            rectPoints = New Point(e.X - offsetX, e.Y - offsetY)
            selSize = New Size(RectInfo.Width, RectInfo.Height)
          End If
        End If

        '------------------------end move sel rect----------------------

        'if left mouse button is not pressed...
      ElseIf Not isDown Then

        'check to see if mouse is within a grab handle
        For l = 0 To grabHandles.Length - 1
          If IsBetween(e.X, e.Y, grabHandles(l)) Then
            picbox_SrcImage.Cursor = curs(l)
            canResize = True
            canMove = False
            curPos = l
            Exit For
            picbox_SrcImage.Cursor = Cursors.Default
            canResize = False
            canMove = False
            curPos = CursorPos.NotOnRect
          End If
        Next l

        'if NOT inside a grab handle, check if mouse is inside sel rect
        If Not canResize AndAlso IsBetween(e.X, e.Y, sr) Then
          picbox_SrcImage.Cursor = Cursors.SizeAll
          canMove = True
          canResize = False
          curPos = CursorPos.Inside

        End If

      End If 'isdown 

    End If 'original is nothing


End Sub

As a selection rectangle is redrawn during MouseMove, the BuildRects() sub is called to update the screen with the current rectangle.

Private Sub BuildRects()
    ' "sr" is the selection rectangle
    ' the "grabHandles" array as the name implies
    ' contains the resize handles for the selection

    sr = New Rectangle(rectPoints, selSize)

    grabHandles(0) = _
    New Rectangle(sr.Left - (grabSize.Width / 2), _
                  sr.Y - (grabSize.Height / 2), grabSize.Width, _
                  grabSize.Height) 'top left

    grabHandles(1) = _
    New Rectangle((sr.Left + (sr.Width / 2)) - grabSize.Width / 2, _
                  sr.Y - (grabSize.Height / 2), _
                  grabSize.Width, grabSize.Height) 'top

    grabHandles(2) = _
    New Rectangle(sr.Right - (grabSize.Width / 2), _
                  sr.Top - (grabSize.Height / 2), _
                  grabSize.Width, grabSize.Height) 'top right

    grabHandles(3) = _
    New Rectangle(sr.Right - (grabSize.Width / 2), _
                  ((sr.Bottom - sr.Height / 2)) _
                  - grabSize.Height / 2, grabSize.Width, _
                  grabSize.Height) 'right

    grabHandles(4) = _
    New Rectangle(sr.Right - (grabSize.Width / 2), _
                  sr.Bottom - (grabSize.Height / 2), _
                  grabSize.Width, grabSize.Height) 'bottom right

    grabHandles(5) = _
    New Rectangle((sr.Right - (sr.Width / 2)) - _
                  grabSize.Width / 2, sr.Bottom - _
                  (grabSize.Height / 2), grabSize.Width, _
                  grabSize.Height) 'bottom

    grabHandles(6) = _
    New Rectangle(sr.Left - (grabSize.Width / 2), _
                  sr.Bottom - (grabSize.Height / 2), _
                  grabSize.Width, grabSize.Height) 'bottom left

    grabHandles(7) = _
    New Rectangle(sr.Left - (grabSize.Width / 2), _
                  (sr.Bottom - (sr.Height / 2)) _
                  - grabSize.Height / 2, grabSize.Width, _
                  grabSize.Height) 'left

    'if "Update tile during selection" checkbox
    'is checked then create tile while dragging
    'mouse. Otherwise wait until mouse button
    'is released.
    If chk_AutoCreate.Checked Then
    End If
End Sub

When the mouse button is released, the createTile() sub is called to create the new tile image.

Private Sub createTile()

    If sr.Width > 0 AndAlso sr.Height > 0 Then 'if a selection rect is drawn

        'create image from selection
        Dim flipImg As New Bitmap(sr.Width, sr.Height)
        Dim flipGrph As Graphics = Graphics.FromImage(flipImg)
        Dim destRect As New Rectangle(0, 0, sr.Width, sr.Height)
        Dim srcRect As New Rectangle(sr.Left, sr.Top, sr.Width, sr.Height)
        flipGrph.DrawImage(original, destRect, srcRect, GraphicsUnit.Pixel)

        'create the empty bitmap for drawing the mirrored inner tiles
        'tmp is a temporary bmp used to create the image
        Dim tmp As Bitmap = New Bitmap(flipImg.Width * 2, flipImg.Height * 2)
        'selBMP = New Bitmap(flipImg.Width * 2, flipImg.Height * 2)
        Dim tileG As Graphics = Graphics.FromImage(tmp)

        'draw inner tiles in selBMP...
        'top left...
        tileG.DrawImage(flipImg, 0, 0, flipImg.Width, flipImg.Height)

        'top right
        tileG.DrawImage(flipImg, flipImg.Width, 0, flipImg.Width, flipImg.Height)

        'bottom right
        tileG.DrawImage(flipImg, flipImg.Width, flipImg.Height, _
                        flipImg.Width, flipImg.Height)

        'bottom left
        tileG.DrawImage(flipImg, 0, flipImg.Height, flipImg.Width, flipImg.Height)

        'rotate the finished tile 90 deg clockwise
        'this is the only flip/rotate that has any meaningful
        'effect. Flipping the first inner tile affects only
        'what is shown at the left of the bkgnd and doesn't
        'affect the rest of the display.
        If chk_RotateTile90.Checked Then
        End If

        Dim newW, newH As Integer
        newW = (tmp.Width / 100) * sldr_SizeW.Value
        newH = (tmp.Height / 100) * sldr_SizeH.Value
        selBMP = New Bitmap(tmp, newW, newH)

        picbox_TilePreview.Image = selBMP
        pntPnl.BackgroundImage = selBMP

      Catch ex As Exception
        MsgBox("Error creating tile:" & Chr(10) & ex.ToString, _
               MsgBoxStyle.Exclamation, title)
      End Try

    End If
End Sub

And once the selection rectangle and the tile are complete, the Paint event is triggered by Me.Invalidate(). Note that only the rectangles are drawn. It isn't necessary to redraw the source image since it's been set as the PictureBox's background image.

Private Sub main_Paint(ByVal sender As Object, ByVal e As _
        System.Windows.Forms.PaintEventArgs) Handles Me.Paint
      If original IsNot Nothing Then 'if a source image is loaded

        'copy of original to display
        bmp = New Bitmap(original.Width, original.Height)
        g = Graphics.FromImage(bmp)
        'draw the selection rectangle and grab-handles
        If sr.Width > 0 AndAlso sr.Height > 0 Then
          g.FillRectangle(innerBrush, sr)
          g.DrawRectangle(myPen, sr)

          g.FillRectangles(grabBrush, grabHandles)
          g.DrawRectangles(grabPen, grabHandles)

        End If
        picbox_SrcImage.Image = bmp
      End If
    Catch ex As Exception
    End Try
End Sub

Resizing the Tile

The trackbars in the left pane allow for resizing the tile. The changes are instantly reflected in the tile preview above the trackbars and in the page preview below them if the "Update tile during selection" checkbox is checked. Otherwise the image is updated when the mouse is released (better for large tiles). The math involved is based on percentages rather than the actual dimensions of the tile, ranging from 10 percent to 200 percent. You'll find the code near the end of the CreateTile() sub. Clicking the "1:1" button below the trackbars resets both of them to 100%.

Setting your wallpaper from BTC

This release includes the ability to set your desktop wallpaper from the program. Here's how it works:

In the project properties, I added a reference to Shell32.dll.

The WinAPI class does the actual work:

Imports System.Runtime.InteropServices

Public Class WinAPI
  <DllImport("user32.dll", CharSet:=CharSet.Auto)> _
Public Shared Function SystemParametersInfo(ByVal uAction As Integer, _
       ByVal uParam As Integer, ByVal lpvParam As String, _
       ByVal fuWinIni As Integer) As Integer
  End Function
  Public Const SPI_SETDESKWALLPAPER As Integer = 20
  Public Const SPIF_SENDCHANGE As Integer = &H2
  Public Const SPIF_UPDATEINIFILE As Integer = &H1&
  Public Const SPIF_SENDWININICHANGE As Integer = &H2&
End Class

In the BTC window, click the Wallpaper button in the tool bar, which resembles a computer monitor. First, BTC checks to be sure the tile is saved in either .bmp or .jpg format. These are the only formats Windows will accept (at least my version). Next, it checks to see if the tile has unsaved changes. If it does, you'll be prompted to save it before continuing. The Boolean variable isSaved is set to False when you alter the tile, and True when you save it. Once that's out of the way, a Shell object is created for the purpose of minimizing all open windows (including BTC) so the desktop is visible. Lastly, BTC opens the dialog_Wallpaper dialogbox.

Here's the Click event handler:

Private Sub tb_SetWP_Click() Handles tb_SetWP.Click

    If Not tilePath.EndsWith(".jpg") AndAlso _
           Not tilePath.EndsWith(".bmp") Then
      msg = "Image must be saved in either .jpg" & Chr(10)
      msg &= "or .bmp format. These are the only formats" & Chr(10)
      msg &= "Windows recognizes for wallpaper."
      MsgBox(msg, MsgBoxStyle.Information, title)
      Exit Sub
    End If

    If Not isSaved Then
      msg = "The image has unsaved changes. You must" & Chr(10)
      msg &= "first save the image. BE SURE to save it in either .jpg" & Chr(10)
      msg &= "or .bmp format. These are the only formats Windows" & Chr(10)
      msg &= "recognizes for wallpaper."
      MsgBox(msg, MsgBoxStyle.Information, title)
      Exit Sub
    End If

    'hide all open windows before opening wp dialog
      Dim sh As New Shell
      sh = Nothing
    Catch ex As Exception
      MsgBox(ex.ToString, MsgBoxStyle.Exclamation, title)
    End Try
End Sub

The Wallpaper dialog box

Here's the complete code listing for the dialog. There are comments to explain what it's doing.

Imports System.Windows.Forms
Imports System.Drawing
Imports System.IO
Imports Microsoft.Win32

Public Class dialog_WallPaper
  Dim imgPath As String = main.tilePath 'the path to your saved tile
  'in the event you change your mind these variables will contain your
  'previous wallpaper info
  Dim oldPath As String 
  Dim oldStyle As String
  Dim oldTile As String

   'the dialog's load event
  Private Sub dialog_WallPaper_Load(ByVal sender As Object, _
          ByVal e As System.EventArgs) Handles Me.Load
    'minimize the main window
    main.WindowState = FormWindowState.Minimized

    'get your current wallpaper settings from the registry
    oldPath = My.Computer.Registry.GetValue(_
       "HKEY_CURRENT_USER\Control Panel\Desktop", "WallPaper", Nothing)
    oldStyle = My.Computer.Registry.GetValue(_
       "HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperStyle", Nothing)
    oldTile = My.Computer.Registry.GetValue(_
       "HKEY_CURRENT_USER\Control Panel\Desktop", "TileWallpaper", Nothing)
    'set the wallpaper to the new tile
    SetWallpaper("1", "1")

  End Sub

  '"Accept" button - close the dialog and leave the new tile as your WP
  Private Sub OK_Button_Click(ByVal sender As System.Object, _
          ByVal e As System.EventArgs) Handles OK_Button.Click
    main.WindowState = FormWindowState.Maximized
    Me.DialogResult = System.Windows.Forms.DialogResult.OK
  End Sub

  '"Decline" button - close the dialog and revert to your original WP
  Private Sub Cancel_Button_Click(ByVal sender As System.Object, _
          ByVal e As System.EventArgs) Handles Cancel_Button.Click

    'set wp back to previous image and settings before closing
    My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", _
                                  "WallPaper", oldPath)
    My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", _
                                  "WallpaperStyle", oldStyle)
    My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", _
                                  "TileWallpaper", oldTile)
    WinAPI.SystemParametersInfo(WinAPI.SPI_SETDESKWALLPAPER, 0, oldPath, _
    main.WindowState = FormWindowState.Maximized
    Me.DialogResult = System.Windows.Forms.DialogResult.Cancel
  End Sub

   'sets the wallpaper to the new tile
   'writes the 3 necessary values to the registry
  Private Sub SetWallpaper(ByVal styleNum As String, ByVal tile As String)
    My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", _
                                  "WallpaperStyle", styleNum)
    My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", _
                                  "TileWallpaper", tile)
    My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", _
                                  "WallPaper", main.tilePath)
    WinAPI.SystemParametersInfo(WinAPI.SPI_SETDESKWALLPAPER, 0, main.tilePath, _
  End Sub
End Class

The help file

I've dropped in a help file, written strictly for the end user, that opens from the tool bar. The HTML is contained in The form that opens contains a WebBrowser control, and the Load event includes code to set its DocumentText property to the resource.

Points of interest

If you'd like to see samples of tiles created with BTC, visit this page. Scroll down to the slide show and click through the images. The page background will display each tile as it's selected. You'll need JavaScript enabled in your browser.

One thing I learned while writing BTC was how to implement a selection rectangle. Drawing a rectangle with the mouse is easy, but a properly functioning selection rectangle is a bit more involved. BTC's selection rectangle does not include functionality to scroll the source image if you drag the selection beyond the edges of the display. Given that tiles are generally small, I didn't think it was necessary, although I may add it later on.

In this most recent release, I also learned a bit about working with the Registry and the Shell. I have always steered clear of both in the past, so this was something new for me. If you see something I should have done differently in this regard, feel free to let me know.


  • First release: July 2011.
  • Second release: Uploaded August 2011.
  • Third release: Uploaded August 29, 2011.
  • Fourth release (bug-fix): Uploaded September 2, 2011.


This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


About the Author

Alan Burkhart
United States United States
I'm not an IT guy. Programming has been a hobby for me (and occasionally useful) ever since a sister in-law introduced me to a TI-99 4/A about a million years ago.

The creative challenge is relaxing and enjoyable. As such, I'd never mess up a fun hobby by doing it for a living.

Now, if I can just get Code Project to add "Truck Driver" to the list of job titles in the profiles...

Comments and Discussions

GeneralMy vote of 5 Pin
Manoj Kumar Choubey20-Feb-12 21:37
professionalManoj Kumar Choubey20-Feb-12 21:37 
GeneralMy vote of 5 Pin
RedDk6-Sep-11 7:20
memberRedDk6-Sep-11 7:20 
Question>5 Pin
RedDk6-Sep-11 7:18
memberRedDk6-Sep-11 7:18 
GeneralRe: >5 [modified] Pin
Alan Burkhart6-Sep-11 8:20
memberAlan Burkhart6-Sep-11 8:20 
GeneralMy vote of 5 Pin
Jamal Alqabandi15-Aug-11 21:35
memberJamal Alqabandi15-Aug-11 21:35 
GeneralRe: My vote of 5 Pin
Alan Burkhart16-Aug-11 3:13
memberAlan Burkhart16-Aug-11 3:13 
QuestionI quite like it considering your "Aint an IT Guy" Pin
Sacha Barber8-Aug-11 6:09
mvaSacha Barber8-Aug-11 6:09 
AnswerRe: I quite like it considering your "Aint an IT Guy" Pin
Alan Burkhart8-Aug-11 9:37
memberAlan Burkhart8-Aug-11 9:37 
GeneralMy vote of 5 Pin
rspercy6526-Jul-11 16:44
memberrspercy6526-Jul-11 16:44 
GeneralRe: My vote of 5 Pin
Alan Burkhart8-Aug-11 5:56
memberAlan Burkhart8-Aug-11 5:56 
GeneralMy vote of 4 Pin
James Garner (jadaradix)25-Jul-11 13:19
memberJames Garner (jadaradix)25-Jul-11 13:19 
GeneralRe: My vote of 4 Pin
Alan Burkhart25-Jul-11 14:48
memberAlan Burkhart25-Jul-11 14:48 
GeneralRe: My vote of 4 Pin
James Garner (jadaradix)25-Jul-11 22:50
memberJames Garner (jadaradix)25-Jul-11 22:50 
GeneralRe: My vote of 4 Pin
Alan Burkhart26-Jul-11 10:46
memberAlan Burkhart26-Jul-11 10:46 
GeneralRe: My vote of 4 Pin
Alan Burkhart8-Aug-11 5:57
memberAlan Burkhart8-Aug-11 5:57 
GeneralRe: My vote of 4 Pin
James Garner (jadaradix)8-Aug-11 10:28
memberJames Garner (jadaradix)8-Aug-11 10:28 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.

Posted 24 Jul 2011


35 bookmarked