Click here to Skip to main content
15,896,201 members
Articles / Multimedia / GDI+

Background Tile Creator

Rate me:
Please Sign up or sign in to vote.
4.88/5 (21 votes)
2 Sep 2011CPOL7 min read 46.6K   1.5K   35  
A small utility for creating interesting background tile images. Includes "Set as Wallpaper" feature
Imports System.Windows.Forms
Imports System.IO
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Math
Imports System.Runtime.InteropServices
Imports Shell32

Public Class main

#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

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

#End Region

  Private Sub LoadApplication() Handles MyBase.Load
    Me.WindowState = FormWindowState.Maximized

    'set initial directories for open and save dialogs
    Try
      If Directory.Exists(My.Settings.def_OpenDir) Then
        dialog_Open.InitialDirectory = My.Settings.def_OpenDir
      Else
        dialog_Open.InitialDirectory = _
        Environment.GetFolderPath(Environment.SpecialFolder.MyPictures)
      End If
    Catch ex As Exception
      dialog_Open.InitialDirectory = My.Computer.FileSystem.CurrentDirectory
    End Try

    Try
      If Directory.Exists(My.Settings.def_SaveDir) Then
        dialog_SaveAs.InitialDirectory = My.Settings.def_SaveDir
      Else
        dialog_SaveAs.InitialDirectory = _
        Environment.GetFolderPath(Environment.SpecialFolder.MyPictures)
      End If
    Catch ex As Exception
      dialog_SaveAs.InitialDirectory = My.Computer.FileSystem.CurrentDirectory
    End Try

    '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 is used with selection rectangle
    myPen.DashStyle = Drawing2D.DashStyle.Dash
    'pntPnl is the drawing surface for the bkgnd preview
    splt_Left.Panel2.Controls.Add(pntPnl)
    pntPnl.Dock = DockStyle.Fill
    UpdateUI()
  End Sub

  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

      Try
        If Directory.Exists(dialog_Open.InitialDirectory) Then
          My.Settings.def_OpenDir = dialog_Open.InitialDirectory
        End If
      Catch ex As Exception
        'just leave the existing setting
      End Try

      Try
        If Directory.Exists(dialog_SaveAs.InitialDirectory) Then
          My.Settings.def_SaveDir = dialog_SaveAs.InitialDirectory
        End If
      Catch ex As Exception
        'just leave the existing setting
      End Try

      My.Settings.Save()
    End If

  End Sub
 
#Region "tool bar buttons"

  Private Sub OpenFileFromDialog() Handles tb_Open.ButtonClick
    dialog_Open.FileName = ""
    res = dialog_Open.ShowDialog
    If res = Windows.Forms.DialogResult.OK Then
      Try
        OpenNewSourceImage(dialog_Open.FileName)
        dialog_Open.InitialDirectory = Path.GetDirectoryName(dialog_Open.FileName)

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

  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)
        dialog_Open.InitialDirectory = Path.GetDirectoryName(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

  Private Sub OpenNewSourceImage(ByVal imgPath As String)
    Try
      'create source image
      Dim tmpBMP As Bitmap = Bitmap.FromFile(imgPath)
      original = New Bitmap(tmpBMP.Width, tmpBMP.Height)
      Dim tmpG As Graphics = Graphics.FromImage(original)
      tmpG.DrawImage(tmpBMP, 0, 0, tmpBMP.Width, tmpBMP.Height)
      tmpBMP.Dispose()

      imgName = 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

  'update recently opened source images each time a new image is opened
  'does not allow duplicates
  Private Sub UpdateRecentFiles()
    Try
      Dim tf As Boolean = False
      For Each s As ToolStripMenuItem In tb_Open.DropDownItems
        If s.Text = imgName Then
          tf = True : Exit For
        End If
      Next
      If Not tf Then
        tb_Open.DropDownItems.Add(imgName)
        If tb_Open.DropDownItems.Count > 5 Then
          tb_Open.DropDownItems.RemoveAt(0)
        End If
      End If
    Catch ex As Exception
      MsgBox(ex.ToString, MsgBoxStyle.Exclamation, title)
    End Try
  End Sub

  Private Sub SaveTile() Handles tb_Save.Click
    dialog_SaveAs.FileName = ""
    res = dialog_SaveAs.ShowDialog
    Try

      If res = Windows.Forms.DialogResult.OK Then
        Dim imgFmt As ImageFormat
        Select Case Path.GetExtension(dialog_SaveAs.FileName)
          Case ".jpg"
            imgFmt = ImageFormat.Jpeg
          Case ".gif"
            imgFmt = ImageFormat.Gif
          Case ".bmp"
            imgFmt = ImageFormat.Bmp
          Case ".png"
            imgFmt = ImageFormat.Png
          Case Else
            msg = "Invalid format"
            MsgBox(msg, MsgBoxStyle.Information, "Error")
            isSaved = False
            Exit Sub
        End Select

        Try
          selBMP.Save(dialog_SaveAs.FileName, imgFmt)
          isSaved = True
          tilePath = dialog_SaveAs.FileName 'for setting wallpaper
          dialog_SaveAs.InitialDirectory = Path.GetDirectoryName(dialog_SaveAs.FileName)
        Catch ex As Exception
          MsgBox("Error saving image..." & Chr(10) & ex.ToString, MsgBoxStyle.Exclamation, title)
        End Try

      End If

    Catch ex As Exception
      MsgBox(ex.ToString)
    End Try
  End Sub

  Private Sub CloseApp() Handles tb_Exit.Click
    Try
      Application.Exit()
    Catch ex As Exception
      MsgBox(ex.ToString, MsgBoxStyle.Exclamation, title)
    End Try
  End Sub

#End Region

#Region "drawing and interface updates"

  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

        bmp = New Bitmap(original.Width, original.Height) 'copy of original to display
        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

  Private Sub createTile()

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

      Try
        isSaved = False
        tb_SetWP.Enabled = False
        '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


        Try
          selBMP.Dispose()
        Catch ex As Exception
          'get rid of previous instance to avoid GDI+ error
          'and catch null ref error if it doesn't exist yet
        End Try


        '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()

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

    End If
  End Sub

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

    isSaved = False
    tb_SetWP.Enabled = False
    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 chk_AutoCreate.Checked Then
      createTile()
    Else
      Me.Invalidate()
    End If

  End Sub

  Private Sub UpdateUI()
    Try
      If Not selBMP Is Nothing Then
        tb_Save.Enabled = True
        sldr_SizeH.Enabled = True
        sldr_SizeW.Enabled = True
      Else
        tb_Save.Enabled = False
        tb_SetWP.Enabled = False
        sldr_SizeH.Enabled = False
        sldr_SizeW.Enabled = False
      End If

      If isSaved AndAlso Not selBMP Is Nothing Then
        tb_SetWP.Enabled = True
      End If

      If sr.Width > 0 AndAlso sr.Height > 0 Then
        statLabel_SelSize.Text = "Selection Size: " & sr.Width.ToString & " x " & sr.Height.ToString
      Else
        statLabel_SelSize.Text = "No selection"
      End If

      If Not selBMP Is Nothing Then
        statLabel_TileSize.Text = "Tile Size: " & selBMP.Width.ToString & " x " & selBMP.Height.ToString
      End If



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


  End Sub

#End Region

#Region "mouse events"

  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

  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

  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

  'check to see if mouse is inside a grab handle
  Private Function IsBetween(ByVal mousex As Integer, ByVal mousey As Integer, ByVal rect As Rectangle)
    If mousex >= rect.X AndAlso mousex <= rect.Right AndAlso mousey >= rect.Y AndAlso mousey <= rect.Bottom Then
      Return True
    Else
      Return False
    End If
  End Function


#End Region

  Private Sub sldr_SizeH_Scroll() Handles sldr_SizeH.Scroll
    label_SldrHValue.Text = sldr_SizeH.Value.ToString & "%"
    createTile()
  End Sub

  Private Sub sldr_SizeW_Scroll() Handles sldr_SizeW.Scroll
    label_SldrWValue.Text = sldr_SizeW.Value.ToString & "%"
    createTile()
  End Sub

  Private Sub sldr_SizeH_ValueChanged() Handles sldr_SizeH.ValueChanged
    label_SldrHValue.Text = sldr_SizeH.Value.ToString & "%"
  End Sub

  Private Sub sldr_SizeW_ValueChanged() Handles sldr_SizeW.ValueChanged
    label_SldrWValue.Text = sldr_SizeW.Value.ToString & "%"
  End Sub

  Private Sub btn_100Pct_Click() Handles btn_100Pct.Click
    sldr_SizeH.Value = 100
    sldr_SizeW.Value = 100
    createTile()
  End Sub

  Private Sub chk_RotateTile90_CheckedChanged() Handles chk_RotateTile90.CheckedChanged
    'swap trackbar values when rotating tile
    Dim zz As Integer = sldr_SizeH.Value
    sldr_SizeH.Value = sldr_SizeW.Value
    sldr_SizeW.Value = zz
    createTile()
  End Sub

  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

  Private Sub tb_Help_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tb_Help.Click
    Try
      helpfile.Show()

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

End Class

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

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


Written By
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