Background Tile Creator
4.88/5 (21 votes)
A small utility for creating interesting background tile images. Includes "Set as Wallpaper" feature
Introduction
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
Next
End If
'--------------End of dropdown list addition---------------
AddHandler Me.Activated, AddressOf UpdateUI
myPen.DashStyle = Drawing2D.DashStyle.Dash
splt_Left.Panel2.Controls.Add(pntPnl)
pntPnl.Dock = DockStyle.Fill
UpdateUI()
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
Next
My.Settings.RecentFiles = itemStr
My.Settings.Save()
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
Try
If Directory.Exists(Path.GetDirectoryName(openPath)) Then
dialog_Open.InitialDirectory = openPath
Else
dialog_Open.InitialDirectory = _
Environment.GetFolderPath(Environment.SpecialFolder.MyPictures)
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
Try
OpenNewSourceImage(dialog_Open.FileName)
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
Try
If File.Exists(e.ClickedItem.Text) Then
OpenNewSourceImage(e.ClickedItem.Text)
Else
tb_Open.DropDownItems.Remove(e.ClickedItem)
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)
Try
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
Me.Invalidate()
'clear the tile preview picturebox
picbox_TilePreview.Image = Nothing
UpdateUI()
UpdateRecentFiles()
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:
- When the left mouse button is pressed:
- When the mouse button is released...
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 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 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
Me.Invalidate()
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
createTile()
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
Try
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
'My.Application.DoEvents()
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))
BuildRects()
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))
BuildRects()
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)
BuildRects()
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)
BuildRects()
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))
BuildRects()
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))
BuildRects()
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))
BuildRects()
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))
BuildRects()
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)
BuildRects()
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
Else
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
My.Application.DoEvents()
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
createTile()
Else
Me.Invalidate()
End If
UpdateUI()
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
Try
'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
flipImg.RotateFlip(RotateFlipType.RotateNoneFlipX)
tileG.DrawImage(flipImg, flipImg.Width, 0, flipImg.Width, flipImg.Height)
'bottom right
flipImg.RotateFlip(RotateFlipType.RotateNoneFlipY)
tileG.DrawImage(flipImg, flipImg.Width, flipImg.Height, _
flipImg.Width, flipImg.Height)
'bottom left
flipImg.RotateFlip(RotateFlipType.RotateNoneFlipX)
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
tmp.RotateFlip(RotateFlipType.Rotate90FlipNone)
End If
'resize
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
Me.Invalidate()
My.Application.DoEvents()
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
Try
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
g.Dispose()
End If
UpdateUI()
Catch ex As Exception
MsgBox(ex.ToString)
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
Try
Dim sh As New Shell
sh.MinimizeAll()
dialog_WallPaper.ShowDialog()
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
Me.Close()
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, _
WinAPI.SPIF_UPDATEINIFILE Or WinAPI.SPIF_SENDWININICHANGE)
main.WindowState = FormWindowState.Maximized
Me.DialogResult = System.Windows.Forms.DialogResult.Cancel
Me.Close()
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, _
WinAPI.SPIF_UPDATEINIFILE Or WinAPI.SPIF_SENDWININICHANGE)
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 My.Resources.help. 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.
History
- First release: July 2011.
- Second release: Uploaded August 2011.
- Third release: Uploaded August 29, 2011.
- Fourth release (bug-fix): Uploaded September 2, 2011.