Moti Barski super


Posts : 499 Join date : 2011-08-02
 | Subject: vb.net image object paster Sun Apr 28, 2013 4:34 pm | |
| 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  | |
|