The GraphicsPath from the System.Drawing.Drawing2D allows you to select an area from an image and manipulate it.
On this small project I have two almost identical Procedures. The only difference is the color picked in one of them using a bitmap and "GetPixel()". The other uses "Color.White" to clear a section of the image.
This is just an example, and is not automated; I have altered an image like the one on top-left(just for comparison) to convert it to the one on bottom-left. The other one have some areas cleared. This is done by clicking and dragging the mouse over the image.
What I do is to click on an area with the color I want and with a small curved drag enclose the area I want to cover. The smaller, the better, so the clearing doesn't show too much like a flat color area. At MouseUp the enclosed area is floded with the color picked.
That's it!
Here is the code:
Imports System.Drawing.Drawing2D
Public Class Form1
Private TracedPath As New GraphicsPath(Drawing2D.FillMode.Winding)
Private ThePoints() As Point
Private NumPoints As Integer
Dim ClearColor As Color = Color.White
Where we declare the path, the array to contain the points of the path, a counter for the amount of points and an initial color, set to white.
For the color retouching we create a bitmap from the image and get the color form a pixel. Clear the path and set first value for the array of points:
Private Sub Work_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Work.MouseDown
'create Bitmap To Select Color
Dim bmx As Bitmap
bmx = New Bitmap(Work.Image)
ClearColor = bmx.GetPixel(e.X, e.Y)
bmx = Nothing
TracedPath.Reset()
' Clear previous drawing.
' Keep the starting point.
NumPoints = 0
ReDim ThePoints(NumPoints)
ThePoints(NumPoints).X = e.X
ThePoints(NumPoints).Y = e.Y
End Sub
To fill the rest of points and make the path, we drag the mouse over the image, the mousemove routine will exit if we are just hovering.
At the same time we are filling the array we are drawing the path, but it is of the selected color, that may be similar to the surrounding ones, so it won't show too much:
Private Sub Work_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Work.MouseMove
If (e.Button = MouseButtons.Left) Then
' Exit if we're not selecting an Area.
If ThePoints Is Nothing Then Exit Sub
' Save next point.
NumPoints += 1
ReDim Preserve ThePoints(NumPoints)
ThePoints(NumPoints).X = e.X
ThePoints(NumPoints).Y = e.Y
Dim MyPen As New Pen(ClearColor, 2) 'Picked color
' Draw the lines.
Dim gr As Graphics = Work.CreateGraphics
gr.DrawLine(MyPen, _
ThePoints(NumPoints).X, _
ThePoints(NumPoints).Y, _
ThePoints(NumPoints - 1).X, _
ThePoints(NumPoints - 1).Y)
End If
End Sub
At mouseup, we complete the enclosed area with an extra point, that is the first one where we clicked at the beginning and add lines to make it a closed area. Then we fill the polygon with our picked color. Then we reset everything:
Private Sub Work_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Work.MouseUp
Dim MyGraphics As Graphics
Dim TransBrush As New SolidBrush(ClearColor)
' Exit if we're not creating a region.
If ThePoints Is Nothing Then Exit Sub
' Close the region.
If (ThePoints(0).X <> ThePoints(NumPoints).X) Or _
(ThePoints(0).Y <> ThePoints(NumPoints).Y) _
Then
' Save Next point.
NumPoints += 1
ReDim Preserve ThePoints(NumPoints)
ThePoints(NumPoints).X = ThePoints(0).X
ThePoints(NumPoints).Y = ThePoints(0).Y
End If
' Set points into a Path.
TracedPath.AddLines(ThePoints)
Try
Dim bm As New Bitmap(Work.Image)
MyGraphics = Graphics.FromImage(bm)
MyGraphics.FillPolygon(TransBrush, ThePoints)
Work.Image = bm
ThePoints = Nothing
GC.Collect()
Catch
MessageBox.Show("Error")
ThePoints = Nothing
Exit Sub
End Try
End Sub
On the picture at right, we use the same code, except the part where we pick a color, so the polygon is filled with white instead:
Private Sub cross_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Cross.MouseDown
TracedPath.Reset()
' Erase any previous drawing.
' Save the starting point.
NumPoints = 0
ReDim ThePoints(NumPoints)
ThePoints(NumPoints).X = e.X
ThePoints(NumPoints).Y = e.Y
End Sub
Private Sub Cross_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Cross.MouseMove
If (e.Button = MouseButtons.Left) Then
' Exit if we're not selecting an Area.
If ThePoints Is Nothing Then Exit Sub
' Save next point.
NumPoints += 1
ReDim Preserve ThePoints(NumPoints)
ThePoints(NumPoints).X = e.X
ThePoints(NumPoints).Y = e.Y
' Draw lines.
Dim gr As Graphics = Cross.CreateGraphics
gr.DrawLine(Pens.White, _
ThePoints(NumPoints).X, _
ThePoints(NumPoints).Y, _
ThePoints(NumPoints - 1).X, _
ThePoints(NumPoints - 1).Y)
End If
End Sub
Private Sub Cross_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Cross.MouseUp
Dim MyGraphics As Graphics
Dim TransBrush As New SolidBrush(Color.White)
' Exit if we're not selecting an Area.
If ThePoints Is Nothing Then Exit Sub
' Close the region.
If (ThePoints(0).X <> ThePoints(NumPoints).X) Or _
(ThePoints(0).Y <> ThePoints(NumPoints).Y) _
Then
' Save next point.
NumPoints += 1
ReDim Preserve ThePoints(NumPoints)
ThePoints(NumPoints).X = ThePoints(0).X
ThePoints(NumPoints).Y = ThePoints(0).Y
End If
' Set points into a Path.
TracedPath.AddLines(ThePoints)
Try
Dim bm As New Bitmap(Cross.Image)
MyGraphics = Graphics.FromImage(bm)
MyGraphics.FillPolygon(TransBrush, ThePoints)
Cross.Image = bm
ThePoints = Nothing
GC.Collect()
Catch
MessageBox.Show("Error")
ThePoints = Nothing
Exit Sub
End Try
End Sub
End Class
Please find the attached project.
regards,
ricardosms.
Attached File(s)
-
Re-Touch.zip (176.81K)
Number of downloads: 385
MultiQuote
| 