Hello!
This small program came as a byproduct of a CrossStitch pattern creation program I was working on.
It is not as usefull as a complete program, but I can give you some ideas to work on.
The process is very simple. Create an area on a image, process the image, clip that area to the original image, and display it as a new image.
The processing of the image is to divide the pixels in squares of n-pixels by n-pixels and set them with an unique color, so the individual color is changed and shows instead an square of the same color.
We run this on a couple of nested loops to go through all the pixels and changing the individual colors. This is done using lockbits, so it happens very quicly. The other menu items are just bell and whistles.
There is an initial image on the picturebox, which can be processed and saved or printed. Other images can be loaded from the open menu item or by dragging and dropping an image from Windows Explorer.
You would check the "Conceal Area" checkbox if you want to select an area, otherwise the full picture will be pixelated. Then you would select the size of the pixelating square from the Numeric UP Down "Pixelate Size", then you will click and trace an area on the picturebox. This will be highlighted in white an then disappear. It will close the area automaticly. Then by pressing "Ok", you will get the pixelated image. If that was not what you wanted, you could "Reload" it and repeat the process.
Then you can save, edit or print the new image.
Very simple, isn't it?
Here is the code:
Imports System
Imports System.Collections
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.ComponentModel
Imports System.Windows.Forms
Imports System.Data
Imports System.Drawing.Imaging
Imports System.IO
Imports System.Drawing.Image
Imports System.Text
Imports System.Math
Imports System.Runtime.InteropServices
Structure MyStruct
Public L As Double
Public R As Double
End Structure
Public Class Form1
Inherits System.Windows.Forms.Form
Private m_Points() As Point 'Array to keep the points of the section to pixelate
Private m_MaxPoint As Integer 'Points contained in the drawing path
Dim gr_visible As Graphics 'Graphics objects needed to process image
Dim gr_result As Graphics
Dim bm_result As Bitmap
Dim WorkImg As Image
Private selected_path As New System.Drawing.Drawing2D.GraphicsPath(Drawing2D.FillMode.Winding)
FormLoad will create the tooltips and addresses of the drag and drop subroutines. Remember to set the form's AllowDrop property to true. The drag and drop process needs to create or assign the same values to variables as a open file operation would do, so the two will have common parts. I have a call to a function "ToRGB" to convert the images to "pixelFormat 24bpprgb, so we have no difficulty creating the graphics objects:
Public Shared Function ToRGB(ByVal original As Bitmap) As Bitmap
Dim newImage As New Bitmap(original.Width, original.Height, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
newImage.SetResolution(original.HorizontalResolution, original.VerticalResolution)
Dim g As Graphics = Graphics.FromImage(newImage)
g.DrawImageUnscaled(original, 0, 0)
g.Dispose()
Return newImage
End Function
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
ToolTip1.SetToolTip(CheckBox1, "Select Area To Conceal ON/OFF")
ToolTip1.SetToolTip(Num1, "Size Of Pixels")
ToolTip1.SetToolTip(PictureBox1, "Click And Drag To Select Area")
PictureBox1.Image = ToRGB(PictureBox1.Image)
PictureBox1.Tag = PictureBox1.Image.Clone 'DragDrop
AddHandler Me.DragDrop, AddressOf Form_DragDrop
AddHandler Me.DragEnter, AddressOf Form_DragEnter
End Sub
Private Sub Form_DragDrop(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs)
Dim strng As String = ""
If e.Data.GetDataPresent(DataFormats.FileDrop) Then
Dim Files() As String
Files = e.Data.GetData(DataFormats.FileDrop)
strng = Files(0).ToLower
If strng.Contains(".jpg") Or strng.Contains(".bmp") Or strng.Contains(".png") Or strng.Contains(".gif") Or strng.Contains(".tif") Then
Dim img As Image
img = ToRGB(Image.FromFile(Files(0)))
PictureBox1.Image = ToRGB(Image.FromFile(Files(0)))
PictureBox1.Tag = ToRGB(Image.FromFile(Files(0)))
WorkImg = ToRGB(Image.FromFile(Files(0)))
Else
MessageBox.Show("Please Try An Image")
End If
End If
End Sub
Private Sub Form_DragEnter(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs)
If e.Data.GetDataPresent(DataFormats.FileDrop) Then
e.Effect = DragDropEffects.All
End If
End Sub
Private Sub OpenToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OpenToolStripMenuItem.Click
Dim f As New OpenFileDialog
Try
With f
.Filter = "Image Files|*.bmp;*.gif;*.jpg;*.png;*.tif"
If .ShowDialog = DialogResult.OK Then
PictureBox1.Image = Image.FromFile(.FileName)
PictureBox1.Tag = Image.FromFile(.FileName)
Try
selected_path.Reset()
gr_visible.Dispose()
gr_result.Dispose()
bm_result.Dispose()
Catch
End Try
End If
End With
Catch ex As Exception
MsgBox(ex.ToString)
Finally
If Not f Is Nothing Then
f.Dispose()
f = Nothing
End If
End Try
End Sub
Creating the path for the section and filling the array with values, occur on picturebox1's MouseDown, MouseMove, and MouseUp routines.
Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
selected_path.Reset()
If CheckBox1.Checked = True Then
' Erase any previous drawing.
' Save the starting point.
m_MaxPoint = 0
ReDim m_Points(m_MaxPoint)
m_Points(m_MaxPoint).X = e.X
m_Points(m_MaxPoint).Y = e.Y
End If
End Sub
Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
If CheckBox1.Checked = True And (e.Button = MouseButtons.Left) Then
' Do nothing if we're not selecting a region.
If m_Points Is Nothing Then Exit Sub
' Save the new point.
m_MaxPoint += 1
ReDim Preserve m_Points(m_MaxPoint)
m_Points(m_MaxPoint).X = e.X
m_Points(m_MaxPoint).Y = e.Y
' Draw the latest line.
Dim gr As Graphics = PictureBox1.CreateGraphics
'gr.DrawLine(Pens.Yellow, _
gr.DrawLine(Pens.White, _
m_Points(m_MaxPoint).X, _
m_Points(m_MaxPoint).Y, _
m_Points(m_MaxPoint - 1).X, _
m_Points(m_MaxPoint - 1).Y)
End If
End Sub
Also the clipping region is set here.
Private Sub PictureBox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
If CheckBox1.Checked = True Then
' Do nothing if we're not selecting a region.
If m_Points Is Nothing Then Exit Sub
' Close the region.
If (m_Points(0).X <> m_Points(m_MaxPoint).X) Or _
(m_Points(0).Y <> m_Points(m_MaxPoint).Y) _
Then
' Save the new point.
m_MaxPoint += 1
ReDim Preserve m_Points(m_MaxPoint)
m_Points(m_MaxPoint).X = m_Points(0).X
m_Points(m_MaxPoint).Y = m_Points(0).Y
End If
' Use the points to create a Path.
selected_path.AddLines(m_Points)
' Make the drawing permanent.
Dim bm_visible As New Bitmap(PictureBox1.Image.Width, PictureBox1.Image.Height)
bm_visible = DirectCast(PictureBox1.Image, Bitmap)
Try
gr_visible = Graphics.FromImage(bm_visible)
' gr_visible.DrawPath(Pens.Red, selected_path)
PictureBox1.Image = bm_visible
' Copy the picture onto picResult,
' restricting it to the selected region.
bm_result = DirectCast(PictureBox1.Image.Clone, Bitmap)
gr_result = Graphics.FromImage(bm_result)
gr_result.SetClip(selected_path, CombineMode.Replace)
' Stop selecting the Area.
m_Points = Nothing
GC.Collect()
Catch
MessageBox.Show("Can't Exclude Section: Pixel format: " & bm_visible.PixelFormat.ToString())
m_Points = Nothing
CheckBox1.Checked = False
Exit Sub
End Try
End If
End Sub
And Process it! The lockbits area is created and locked, then the loops run on the data.
Private Sub btnOk_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnOk.Click
Pixel1()
If CheckBox1.Checked = True Then
' Create parallelogram for drawing image.
Dim ulCorner As New Point(0, 0)
Dim urCorner As New Point(PictureBox1.Width, 0)
Dim llCorner As New Point(0, PictureBox1.Height)
Dim destPara As Point() = {ulCorner, urCorner, llCorner}
' Create rectangle for source image.
Dim SourceRect As New Rectangle(0, 0, PictureBox1.Width, PictureBox1.Height)
Dim units As GraphicsUnit = GraphicsUnit.Pixel
Try
' Draw image to screen.
gr_result.DrawImage(PictureBox1.Image, destPara, SourceRect, units)
PictureBox1.Image = bm_result
Catch
If bm_result IsNot Nothing Then bm_result.Dispose()
End Try
End If
GC.Collect()
End Sub
Private Sub Pixel1()
Dim x, y As Integer
Try
Dim rect As Rectangle = Rectangle.Round(PictureBox1.Image.GetBounds(GraphicsUnit.Pixel))
Dim wid As Integer = PictureBox1.Image.Width
Dim hgt As Integer = PictureBox1.Image.Height
Dim img As New Bitmap(wid, hgt)
img = ToRGB(PictureBox1.Image.Clone) ' WorkImg.Clone
Dim bmpSr As BitmapData = img.LockBits(New Rectangle(0, 0, img.Width, img.Height), ImageLockMode.ReadWrite, img.PixelFormat)
Dim ptrSr As IntPtr = bmpSr.Scan0
Dim R, G, B As Integer
R = 2
G = 1
B = 0
'A = 3
Dim bytesSr As Integer = bmpSr.Stride * img.Height
Dim rgbvaluesSr(bytesSr) As Byte
System.Runtime.InteropServices.Marshal.Copy(ptrSr, rgbvaluesSr, 0, bytesSr)
Dim stp As Integer = 2 * Num1.Value 'Size Of Pixelation
For y = 0 To img.Height - stp - 1 Step stp
For x = y * bmpSr.Stride To (y + 1) * bmpSr.Stride - stp - 1 Step 3 * stp
Dim PromR As Integer = rgbvaluesSr(x + R + 3 * (stp / 2) + (stp / 2) * bmpSr.Stride) / 3 + rgbvaluesSr(x + R + 3 * (1 + stp / 2) + (stp / 2) * bmpSr.Stride) / 3 + rgbvaluesSr(x + R + 3 * (2 + stp / 2) + (stp / 2) * bmpSr.Stride) / 3
Dim PromG As Integer = rgbvaluesSr(x + G + 3 * (stp / 2) + (stp / 2) * bmpSr.Stride) / 3 + rgbvaluesSr(x + G + 3 * (1 + stp / 2) + (stp / 2) * bmpSr.Stride) / 3 + rgbvaluesSr(x + G + 3 * (2 + stp / 2) + (stp / 2) * bmpSr.Stride) / 3
Dim PromB As Integer = rgbvaluesSr(x + B + 3 * (stp / 2) + (stp / 2) * bmpSr.Stride) / 3 + rgbvaluesSr(x + B + 3 * (1 + stp / 2) + (stp / 2) * bmpSr.Stride) / 3 + rgbvaluesSr(x + B + 3 * (2 + stp / 2) + (stp / 2) * bmpSr.Stride) / 3
For Z As Integer = 0 To stp
For Z1 As Integer = 0 To stp
rgbvaluesSr(x + R + Z1 * bmpSr.Stride + 3 * Z) = PromR
rgbvaluesSr(x + G + Z1 * bmpSr.Stride + 3 * Z) = PromG
rgbvaluesSr(x + B + Z1 * bmpSr.Stride + 3 * Z) = PromB
Next Z1
Next Z
If x = (y + 1) * bmpSr.Stride - 6 Then
'Dark Line To the Right
rgbvaluesSr(x + R + 4) = 255
rgbvaluesSr(x + G + 4) = 255
rgbvaluesSr(x + B + 4) = 255
rgbvaluesSr(x + R + 8) = 255
rgbvaluesSr(x + G + 8) = 255
rgbvaluesSr(x + B + 8) = 255
rgbvaluesSr(x + R + 12) = 255
rgbvaluesSr(x + G + 12) = 255
rgbvaluesSr(x + B + 12) = 255
End If
Next x
Next y
System.Runtime.InteropServices.Marshal.Copy(rgbvaluesSr, 0, ptrSr, bytesSr)
img.UnlockBits(bmpSr)
PictureBox1.Image = img
PictureBox1.Invalidate()
Dim bmpFromImage As New Bitmap(PictureBox1.Width, PictureBox1.Height)
bmpFromImage = PictureBox1.Image
Dim g1 As Graphics = Graphics.FromImage(img)
g1.DrawImage(bmpFromImage, 0, 0, img.Width, img.Height)
g1.Dispose()
Catch ex As Exception
MessageBox.Show(ex.ToString)
End Try
End Sub
Here is the rest of the code (the bells and whistles):
Private Sub SaveToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SaveToolStripMenuItem.Click
Dim i As Integer
Dim str As String
For i = 1 To 1000
If i < 10 Then str = "Picture_00" & i.ToString & ".jpg"
If i > 9 And i < 100 Then str = "Picture_0" & i.ToString & ".jpg"
If i > 99 Then str = "Picture_" & i.ToString & ".jpg"
If i > 900 Then MsgBox("You Have Over 900 Pictures, Please Check And Delete Unnecesary Ones")
If Not System.IO.File.Exists(str) Then
Try
PictureBox1.Image.Save(str, System.Drawing.Imaging.ImageFormat.Jpeg) 'Cropped
'PictureBox1.Image.Save(str, System.Drawing.Imaging.ImageFormat.Png)
Catch Ex As Exception
MsgBox("Could Not Write To Location")
End Try
Exit For
End If
Next
End Sub
Private Sub ToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItem1.Click
Clipboard.Clear()
Dim Img As New Bitmap(PictureBox1.Image)
Img.MakeTransparent(Color.DarkBlue)
'Img.MakeTransparent(Color.White)
Clipboard.SetImage(Img)
End Sub
Private Sub CheckBox1_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckBox1.CheckedChanged
If CheckBox1.Checked = False Then
GC.Collect()
selected_path.Reset()
PictureBox1.Image = PictureBox1.Tag
Try
selected_path.Reset()
gr_visible.Dispose()
gr_result.Dispose()
bm_result.Dispose()
PictureBox1.Image = PictureBox1.Tag
GC.Collect()
Catch
End Try
End If
End Sub
Private Sub PrintDocument1_PrintPage(ByVal sender As System.Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs)
Dim newImage As Image = PictureBox1.Image
e.Graphics.DrawImage(newImage, 50, 50)
End Sub
Private Sub PrintToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PrintToolStripMenuItem.Click
Dim PrintDocument1 As Printing.PrintDocument = New Printing.PrintDocument
AddHandler PrintDocument1.PrintPage, AddressOf Me.PrintDocument1_PrintPage
PrintDocument1.Print()
End Sub
Private Sub ExitToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ExitToolStripMenuItem.Click
Me.Close()
End Sub
Private Sub ToolStripMenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItem2.Click
Shell("Explorer " & AppDomain.CurrentDomain.BaseDirectory, AppWinStyle.NormalFocus)
End Sub
Please check the attachments.
Thank you for reading.
ricardosms
Attached File(s)
-
Pixelate.zip (120.3K)
Number of downloads: 198
MultiQuote
| 