vb.net image object paster

Posts : 281 Join date : 2011-08-02

the program pastes an object from a bitmap image without the background on to another image.
the object image's background should be in one color :
white w
black k
red r
yellow y
orange o
green g
blue b
violet v
other u

form controls :

picturebox * 2
textbox * 2
listbox : from its little arrow add :
w
k
r
y
o
g
b
v
u
Button * 4 :
Button1 text property : Button1
Button2 text property : save image
Button3 text property : image to paste
Button4 text property : image for the object to be pasted on to

using the program :
choose the two images
in the text boxes input the x,y positions of the image from which the object will be pasted
x,y can be negative of values. the default values are (0,0)

click the letter representing the background color of the object image on the list box.

if you want the new image to save click the save image button and name the new image :
name.bmp

note : the speed of the program will lower for higher definition images, while the
accuracy will increase. orange, green, blue backgrounds worked best for me in that order.

Code:: Public Class Form1
Dim r1, g1, b1 As Integer
Dim ObjectBackground As Char = "w"
Sub RGB_Values(ByVal inColor As Color, ByRef red As Integer, ByRef green As Integer, ByRef blue As Integer)
' returns value of red,green,blue in a pixel of a bitmap as integers
red = inColor.R
green = inColor.G
blue = inColor.B
End Sub
Public Function getPixelColor(ByVal r As Integer, ByVal g As Integer, ByVal b As Integer) As Char
' r= red, g = green, b = blue
Dim colorchar As Char
If r > 245 And g > 245 And b > 245 Then
colorchar = "w" ' white
ElseIf r < 20 And g < 20 And b < 20 Then
colorchar = "k" ' black (kuro in japanese)
ElseIf r > g And g > b And g < 100 Then
colorchar = "r" ' red
ElseIf r > g And g > b And g > 200 Then
colorchar = "y" ' yellow
ElseIf r > g And g > b And 100 < g < 200 Then
colorchar = "o" 'orange
ElseIf (g > r And r > b) Or (g > b And b > r) Then
colorchar = "g" 'green
ElseIf b > g And g > r Then
colorchar = "b" 'blue
ElseIf (b > r And r > g) Or (r > b And g < 20) Then
colorchar = "v" ' violet
Else
colorchar = "u" ' yet undefined
End If
Return colorchar
End Function
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim px As Integer = 0 ' x,y positions from which the image object will be pasted
Dim py As Integer = 0 ' on the main image
Try
px = TextBox1.Text
Catch ex As Exception

End Try
Try
py = TextBox2.Text
Catch ex As Exception

End Try
Dim I2 As Bitmap ' Image with object to paste
I2 = PictureBox1.Image
Dim I1 As Bitmap ' Image to paste object on
I1 = PictureBox2.Image
Dim EdX As Integer = 0 ' end x,y positions of the object
Dim EdY As Integer = 0
For I = 0 To I2.Width - 1
For j = 0 To I2.Height - 1
RGB_Values(I2.GetPixel(I, j), r1, g1, b1)
If getPixelColor(r1, g1, b1) <> ObjectBackground Then
If EdX < I Then
EdX = I
End If
If EdY < j Then
EdY = j
End If
End If
Next
Next
Dim minX As Integer = EdX
If px >= 0 Then
If minX > I1.Width - px - 1 Then
minX = I1.Width - px - 1
End If
ElseIf minX > I1.Width - 2 Then
minX = I1.Width - 1
End If
Dim minY As Integer = EdY
If py >= 0 Then
If minY > I1.Height - py - 1 Then
minY = I1.Height - py - 1
End If
ElseIf minY > I1.Height - 2 Then
minY = I1.Height - 1
End If
Dim stx As Integer = 0
Dim sty As Integer = 0
If px < 0 Then
StX -= px
px = 0
End If
If py < 0 Then
StY -= py
py = 0
End If
'paste the object without it's background on the main image
For i = StX To minX + StX
For j = StY To minY + StY
RGB_Values(I2.GetPixel(i, j), r1, g1, b1)
If getPixelColor(r1, g1, b1) <> ObjectBackground Then
I1.SetPixel(px + i - StX, py + j - StY, I2.GetPixel(i, j))
End If
Next
Next
PictureBox2.Image = I1
End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
' saves the main image (the one on which the object is pasted)
Dim I1 As Bitmap ' Image to paste object on
I1 = PictureBox2.Image
SaveFileDialog1.ShowDialog() ' open dialog
SaveFileDialog1.Title = "Save an Image File"
SaveFileDialog1.Filter = "Bitmap Image|*.bmp" ' set option for saved file extention
I1.Save(SaveFileDialog1.FileName, Imaging.ImageFormat.Bmp)
End Sub

Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
Try
OpenFileDialog1.ShowDialog()
Dim fs As IO.FileStream = New IO.FileStream(OpenFileDialog1.FileName, IO.FileMode.Open)
Dim bitmap1 As Bitmap
bitmap1 = Image.FromStream(fs)
fs.Close()
PictureBox1.Image = bitmap1
Catch ex As Exception
MsgBox("select an input path picture file")
End Try
End Sub

Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
Try
OpenFileDialog1.ShowDialog()
Dim fs As IO.FileStream = New IO.FileStream(OpenFileDialog1.FileName, IO.FileMode.Open)
Dim bitmap1 As Bitmap
bitmap1 = Image.FromStream(fs)
fs.Close()
PictureBox2.Image = bitmap1
Catch ex As Exception
MsgBox("select an input path picture file")
End Try
End Sub

Private Sub ListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.SelectedIndexChanged
ObjectBackground = ListBox1.SelectedItem
End Sub
End Class

_________________
MB over and out _______________________

» The header image keeps going invisible.
» How to create/recognize object element not using recording?
» How to get text present in an image
» Test javascript Calendar
» How could I pass datafile as parameter to dataProvider