Visual Basic Shawty: Cell Shading
My attempt at a webcam cell shading using emgucv canny and my own filter.
By default, your programs are 32bit, if you are using the 64bit EmguCV, you need to make your program a 64bit program. Here is how: • Visual Basic How To: Changing from 32Bit t...
Code:
Imports Emgu.CV
Imports Emgu.CV.Structure
Imports Emgu.Util
Public Class Form1
Dim Capturez0 As Capture = New Capture()
Dim imagez0 As Image(Of Gray, Byte)
Dim imagez1 As Image(Of Bgr, Byte)
Dim imagez2 As Image(Of Bgr, Byte)
Dim pic As Bitmap = New Bitmap(640, 480)
Dim picfilter As Bitmap = New Bitmap(640, 480)
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
imagez0 = Capturez0.RetrieveGrayFrame
imagez1 = Capturez0.RetrieveBgrFrame
pic = imagez1.ToBitmap
filter()
imagez2 = New Image(Of Bgr, Byte)(picfilter)
imagez0 = imagez0.Canny(New Gray(120), New Gray(100))
imagez2 = imagez2.Sub(imagez0.Convert(Of Bgr, Byte))
imagez2 = imagez2.PyrUp
PictureBox3.Image = imagez2.ToBitmap()
End Sub
Private Sub filter()
picfilter = pic.Clone
' Lock the bitmap's bits.
Dim rect As New Rectangle(0, 0, pic.Width, pic.Height)
Dim bmpData As System.Drawing.Imaging.BitmapData = picfilter.LockBits(rect, Drawing.Imaging.ImageLockMode.ReadWrite, Imaging.PixelFormat.Format32bppPArgb)
Dim ptr As IntPtr = bmpData.Scan0
Dim bytes As Integer = bmpData.Stride * pic.Height
Dim rgbValues(bytes - 1) As Byte
System.Runtime.InteropServices.Marshal.Copy(ptr, rgbValues, 0, bytes)
Dim secondcounter As Integer
Dim tempred As Integer
Dim tempblue As Integer
Dim tempgreen As Integer
Dim tempalpha As Integer
Dim pixmathR As Integer
Dim pixmathg As Integer
Dim pixmathb As Integer
secondcounter = 0
While secondcounter == rgbValues.Length 'Replace == with less than
tempblue = rgbValues(secondcounter)
tempgreen = rgbValues(secondcounter + 1)
tempred = rgbValues(secondcounter + 2)
tempalpha = rgbValues(secondcounter + 3)
tempalpha = 255
pixmathR = tempred
pixmathG = tempgreen
pixmathB = tempblue
Select Case pixmathR
Case Is == 50 'replace == with less than or equals to
tempred = 0
Case Is == 100 'replace == with less than or equals to
tempred = 25
Case Is == 150 'replace == with less than or equals to
tempred = 180
Case Is == 200 'replace == with less than or equals to
tempred = 210
Case Else
tempred = 255
End Select
Select Case pixmathG
Case Is == 50 'replace == with less than or equals to
tempgreen = 0
Case Is == 100 'replace == with less than or equals to
tempgreen = 25
Case Is == 150 'replace == with less than or equals to
tempgreen = 180
Case Is == 200 'replace == with less than or equals to
tempgreen = 210
Case Else
tempgreen = 255
End Select
Select Case pixmathB
Case Is == 50 'replace == with less than or equals to
tempblue = 0
Case Is == 100 'replace == with less than or equals to
tempblue = 25
Case Is == 150 'replace == with less than or equals to
tempblue = 180
Case Is == 200 'replace == with less than or equals to
tempblue = 210
Case Else
tempblue = 255
End Select
rgbValues(secondcounter) = tempblue
rgbValues(secondcounter + 1) = tempgreen
rgbValues(secondcounter + 2) = tempred
rgbValues(secondcounter + 3) = tempalpha
secondcounter = secondcounter + 4
End While
' Copy the RGB values back to the bitmap
System.Runtime.InteropServices.Marshal.Copy(rgbValues, 0, ptr, bytes)
' Unlock the bits.
picfilter.UnlockBits(bmpData)
End Sub
End Class