Home
Search
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
C# Helper...
 
XML RSS Feed
Follow VBHelper on Twitter
 
 
 
MSDN Visual Basic Community
 
 
 
 
 
TitlePixelate areas on an image in VB .NET
DescriptionThis example shows how to pixelate areas on an image in VB .NET. This program shows how to let the user select a rectangular area and how to process that area pixel-by-pixel.
Keywordspixelate, pixellate
CategoriesGraphics, VB.NET
 
The program stores bitmaps holding the original image the user loaded, the current modified image, and an image showing the region that the user is selecting.

When the user presses the mouse on the picCanvas control, the MouseDown event handler starts selecting an area. It makes a temporary bitmap and a Graphics object associated with it.

When the user moves the mouse, the MouseMove event handler copies the current image into the temporary bitmap, draws the new selection rectangle on it, and then displays the result.

When the user releases the mouse, the program stops selecting an area. It ensures that the area selected lies within the picture and calls PixelateArea to pixelate the selected area.

 
Private m_OriginalBitmap As Bitmap
Private m_CurrentBitmap As Bitmap
Private m_TempBitmap As Bitmap
Private m_Gr As Graphics
Private m_Pen As Pen

Private m_SelectingArea As Boolean
Private m_X1 As Integer
Private m_Y1 As Integer

' Start selecting an area.
Private Sub picCanvas_MouseDown(ByVal sender As Object, _
    ByVal e As System.Windows.Forms.MouseEventArgs) Handles _
    picCanvas.MouseDown
    ' Make sure we have a picture loaded.
    If m_OriginalBitmap Is Nothing Then Exit Sub

    mnuDataReset.Enabled = False
    m_SelectingArea = True
    m_X1 = e.X
    m_Y1 = e.Y

    ' Make a copy of the current bitmap 
    'and prepare to draw.
    m_TempBitmap = New Bitmap(m_CurrentBitmap)
    m_Gr = Graphics.FromImage(m_TempBitmap)
    m_Pen = New Pen(Color.Yellow)
    m_Pen.DashStyle = Drawing2D.DashStyle.Dash
End Sub

' Continue selecting the area.
Private Sub picCanvas_MouseMove(ByVal sender As Object, _
    ByVal e As System.Windows.Forms.MouseEventArgs) Handles _
    picCanvas.MouseMove
    If Not m_SelectingArea Then Exit Sub

    ' Start with the current image.
    m_Gr.DrawImage(m_CurrentBitmap, 0, 0)

    ' Draw the new selection box.
    m_Gr.DrawRectangle(m_Pen, _
        Min(m_X1, e.X), _
        Min(m_Y1, e.Y), _
        Abs(e.X - m_X1), _
        Abs(e.Y - m_Y1))

    ' Display the result.
    picCanvas.Image = m_TempBitmap
End Sub

' Finish selecting the area.
Private Sub picCanvas_MouseUp(ByVal sender As Object, ByVal _
    e As System.Windows.Forms.MouseEventArgs) Handles _
    picCanvas.MouseUp
    If Not m_SelectingArea Then Exit Sub
    m_SelectingArea = False

    ' Make sure this point is on the picture.
    Dim x As Integer = e.X
    If x < 0 Then x = 0
    If x > m_OriginalBitmap.Width - 1 Then x = _
        m_OriginalBitmap.Width - 1

    Dim y As Integer = e.Y
    If y < 0 Then y = 0
    If y > m_OriginalBitmap.Height - 1 Then y = _
        m_OriginalBitmap.Height - 1

    ' Pixelate the selected area.
    PixelateArea( _
        Min(m_X1, x), _
        Min(m_Y1, y), _
        Abs(x - m_X1), _
        Abs(y - m_Y1))

    ' We're done drawing for now.
    m_Pen.Dispose()
    m_Gr.Dispose()
    m_TempBitmap.Dispose()

    m_Pen = Nothing
    m_Gr = Nothing
    m_TempBitmap = Nothing

    mnuDataReset.Enabled = True
End Sub
 
Subroutine PixelateArea refreshes the current image. It then makes new_x and new_y be multiples of the desried pixelated cell width and height. This makes different pixelated regions line up niceely. PixelateArea then calls subroutine AverageRectangle for each of the cells in the selected area and displays the result.

Subroutine AverageRectangle ensures that its rectangle doesn't stick out past the edges of the image. It ranges over the pixels in its rectangle adding their red, green, and blue components. It divides those values by the number of pixels to get an average and uses FillRectangle to set all of the pixels to the average color.

 
' Pixelate the area.
Private Sub PixelateArea(ByVal x As Integer, ByVal y As _
    Integer, ByVal wid As Integer, ByVal hgt As Integer)
    Const cell_wid As Integer = 20
    Const cell_hgt As Integer = 10

    ' Start with the current image.
    m_Gr.DrawImage(m_CurrentBitmap, 0, 0)

    ' Make x and y multiples of cell_wid/cell_hgt
    ' from the origin.
    Dim new_x As Integer = cell_wid * Int(x \ cell_wid)
    Dim new_y As Integer = cell_hgt * Int(y \ cell_hgt)

    ' Pixelate the selected area.
    For x1 As Integer = new_x To x + wid Step cell_wid
        For y1 As Integer = new_y To y + hgt Step cell_hgt
            AverageRectangle(x1, y1, cell_wid, cell_hgt)
        Next y1
    Next x1

    ' Set the current bitmap to the result.
    m_CurrentBitmap = New Bitmap(m_TempBitmap)

    ' Display the result.
    picCanvas.Image = m_CurrentBitmap
End Sub

' Fill this rectangle with the average of its pixel values.
Private Sub AverageRectangle(ByVal x As Integer, ByVal y As _
    Integer, ByVal wid As Integer, ByVal hgt As Integer)
    ' Make sure we don't exceed the image's bounds.
    If x < 0 Then x = 0
    If x + wid >= m_OriginalBitmap.Width Then
        wid = m_OriginalBitmap.Width - x - 1
    End If
    If wid <= 0 Then Exit Sub

    If y < 0 Then y = 0
    If y + hgt >= m_OriginalBitmap.Height Then
        hgt = m_OriginalBitmap.Height - y - 1
    End If
    If hgt <= 0 Then Exit Sub

    ' Get the total red, green, and blue values.
    Dim clr As Color
    Dim r As Integer
    Dim g As Integer
    Dim b As Integer
    For i As Integer = 0 To hgt - 1
        For j As Integer = 0 To wid - 1
            clr = m_CurrentBitmap.GetPixel(x + j, y + i)
            r += clr.R
            g += clr.G
            b += clr.B
        Next j
    Next i

    ' Calculate the averages.
    r \= wid * hgt
    g \= wid * hgt
    b \= wid * hgt

    ' Set the pixel values.
    Dim ave_brush As New SolidBrush(Color.FromArgb(255, r, _
        g, b))
    m_Gr.FillRectangle(ave_brush, x, y, wid, hgt)
    ave_brush.Dispose()
End Sub
 
 
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated