Título: [Source] Funciones para marcar contornos de una imagen y marcar piel.
Publicado por: 79137913 en 6 Diciembre 2010, 14:26 pm
HOLA!!! EFECTO: (http://img689.imageshack.us/img689/3381/dibujokqu.png) Gracias a LEANDRO A pude armar una funcion que convierte una imagen cualquiera a una imagen en ByN puro sin escala de grises marcando solamente los contornos de las cosas. AGREGADO: funcion para pintar las zonas que son piel.Hay una variable "Tolerance" esa la regulan para que sea mas o menos estricto con la deteccion de bordes. Bueno aca el codigo (Modulo): Repito GRACIAS LEA! Option Explicit Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hDC As Long, pBitmapInfo As BITMAPINFO24, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long Private Type RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As Byte End Type Private Type BITMAPINFOHEADER biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Long biClrImportant As Long End Type Private Type BITMAPINFO24 bmiHeader As BITMAPINFOHEADER bmiColors() As RGBQUAD End Type Private Type SAFEARRAYBOUND cElements As Long lLbound As Long End Type Private Type SAFEARRAY2D cDims As Integer fFeatures As Integer cbElements As Long cLocks As Long pvData As Long Bounds(0 To 1) As SAFEARRAYBOUND End Type Private Const DIB_RGB_COLORS = 0 Private Const BI_RGB = 0& Public Sub BuscarContornos(Pic As PictureBox) Dim BytesPerLine As Long Dim WinDC As Long Dim TmpDC As Long Dim hBmp As Long Dim OldBmp As Long Dim Addrs As Long Dim x As Long Dim y As Long Dim lpBits() As Byte Dim M_BitmapInfo As BITMAPINFO24 Dim SA As SAFEARRAY2D Dim R As Byte, G As Byte, B As Byte, BYN As Byte, Tolerance As Byte Dim ZERO As Integer Dim tmp1 As Integer, tmp2 As Integer, tmp3 As Integer Tolerance = 20 ZERO = 0 BytesPerLine = ScanAlign(Pic.ScaleWidth * 3) With M_BitmapInfo.bmiHeader .biSize = Len(M_BitmapInfo.bmiHeader) .biWidth = Pic.ScaleWidth .biHeight = Pic.ScaleHeight .biPlanes = 1 .biBitCount = 24 .biCompression = BI_RGB .biSizeImage = BytesPerLine * Pic.ScaleHeight End With WinDC = GetDC(0) TmpDC = CreateCompatibleDC(WinDC) hBmp = CreateDIBSection(WinDC, M_BitmapInfo, DIB_RGB_COLORS, Addrs, 0, 0) Call ReleaseDC(0, WinDC) With SA .cbElements = 1 .cDims = 2 .Bounds(0).lLbound = 0 .Bounds(0).cElements = Pic.ScaleHeight .Bounds(1).lLbound = 0 .Bounds(1).cElements = BytesPerLine .pvData = Addrs End With CopyMemory ByVal VarPtrArray(lpBits), VarPtr(SA), 4 OldBmp = SelectObject(TmpDC, hBmp) Call BitBlt(TmpDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, Pic.hDC, 0, 0, vbSrcCopy) For y = 0 To Pic.ScaleHeight - 1 For x = 0 To (Pic.ScaleWidth * 3) - 1 Step 3 B = lpBits(x + 2, y) G = lpBits(x + 1, y) R = lpBits(x, y) 'ZERO ES PARA QUE NO HAGA DESBORDAMIENTO BYN = Int((ZERO + R + G + B) / 3) 'DIBUJA EN BLANCO Y NEGRO lpBits(x, y) = BYN lpBits(x + 1, y) = BYN lpBits(x + 2, y) = BYN If x <> 0 And y <> 0 Then tmp1 = lpBits(x - 1, y - 1) tmp2 = lpBits(x - 1, y) tmp3 = lpBits(x, y - 1) If Abs(tmp2 - tmp1) > Tolerance Or Abs(tmp3 - tmp1) > Tolerance Then lpBits(x - 1, y - 1) = 0 lpBits(x - 2, y - 1) = 0 lpBits(x - 3, y - 1) = 0 Else 'PINTA DE NEGRO EL PIXEL POR QUE AHI HAY UN BORDE lpBits(x - 1, y - 1) = 255 lpBits(x - 2, y - 1) = 255 lpBits(x - 3, y - 1) = 255 End If End If Next x Next y CopyMemory ByVal VarPtrArray(lpBits), 0&, 4 Call BitBlt(Pic.hDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, TmpDC, 0, 0, vbSrcCopy) Call DeleteObject(SelectObject(TmpDC, OldBmp)) Call DeleteDC(TmpDC) End Sub Public Sub BuscarPiel(Pic As PictureBox) Dim BytesPerLine As Long Dim WinDC As Long Dim TmpDC As Long Dim hBmp As Long Dim OldBmp As Long Dim Addrs As Long Dim x As Long Dim y As Long Dim lpBits() As Byte Dim M_BitmapInfo As BITMAPINFO24 Dim SA As SAFEARRAY2D Dim R As Byte, G As Byte, B As Byte, BYN As Byte, Tolerance As Byte Dim ZERO As Integer Dim tmp1 As Integer, tmp2 As Integer, tmp3 As Integer Tolerance = 20 ZERO = 0 BytesPerLine = ScanAlign(Pic.ScaleWidth * 3) With M_BitmapInfo.bmiHeader .biSize = Len(M_BitmapInfo.bmiHeader) .biWidth = Pic.ScaleWidth .biHeight = Pic.ScaleHeight .biPlanes = 1 .biBitCount = 24 .biCompression = BI_RGB .biSizeImage = BytesPerLine * Pic.ScaleHeight End With WinDC = GetDC(0) TmpDC = CreateCompatibleDC(WinDC) hBmp = CreateDIBSection(WinDC, M_BitmapInfo, DIB_RGB_COLORS, Addrs, 0, 0) Call ReleaseDC(0, WinDC) With SA .cbElements = 1 .cDims = 2 .Bounds(0).lLbound = 0 .Bounds(0).cElements = Pic.ScaleHeight .Bounds(1).lLbound = 0 .Bounds(1).cElements = BytesPerLine .pvData = Addrs End With CopyMemory ByVal VarPtrArray(lpBits), VarPtr(SA), 4 OldBmp = SelectObject(TmpDC, hBmp) Call BitBlt(TmpDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, Pic.hDC, 0, 0, vbSrcCopy) For y = 0 To Pic.ScaleHeight - 1 For x = 0 To (Pic.ScaleWidth * 3) - 1 Step 3 R = lpBits(x + 2, y) G = lpBits(x + 1, y) B = lpBits(x, y) 'ZERO ES PARA QUE NO HAGA DESBORDAMIENTO BYN = Int((ZERO + R + G + B) / 3) 'DIBUJA EN BLANCO Y NEGRO If R > 168 And G > 134 And B > 94 And R < 250 And G < 235 And B < 215 Then ' LOS PROXIMOS 3 VALORES ESPECIFICAN EL COLOR CON EL QUE SE VA A PINTAR lpBits(x, y) = 0 lpBits(x + 1, y) = 255 lpBits(x + 2, y) = 255 Else lpBits(x, y) = 0 ' BYN lpBits(x + 1, y) = 0 'BYN lpBits(x + 2, y) = 0 'BYN End If Next x Next y CopyMemory ByVal VarPtrArray(lpBits), 0&, 4 Call BitBlt(Pic.hDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, TmpDC, 0, 0, vbSrcCopy) Call DeleteObject(SelectObject(TmpDC, OldBmp)) Call DeleteDC(TmpDC) End Sub Private Function ScanAlign(WidthBmp As Long) As Long ScanAlign = (WidthBmp + 3) And &HFFFFFFFC End Function
Para llamar la funcion: Private Sub Command1_Click() 'ESTO PARA CONTORNOS BuscarContornos PicTratamiento 'ESTO PARA PIEL BuscarPiel PicTratamiento PicTratamiento.Refresh End Sub Private Sub Form_Load() PicTratamiento.AutoRedraw = True PicTratamiento.ScaleMode = vbPixels End Sub
P.D: El de la foto soy yo asi que no puteen. GRACIAS POR LEER!!!
Título: Re: [Source] Funcion para marcar contornos de una imagen.
Publicado por: Karcrack en 6 Diciembre 2010, 17:06 pm
Estaria bien poder ver una captura de como queda :P
Título: Re: [Source] Funcion para marcar contornos de una imagen.
Publicado por: 79137913 en 6 Diciembre 2010, 19:15 pm
HOLA!!!
Karcrack: Listo ahi esta la imagen :P
GRACIAS POR LEER!!!
Título: Re: [Source] Funcion para marcar contornos de una imagen.
Publicado por: ssccaann43 © en 6 Diciembre 2010, 19:29 pm
Excelente
Título: Re: [Source] Funciones para marcar contornos de una imagen y marcar piel.
Publicado por: 79137913 en 6 Diciembre 2010, 20:02 pm
HOLA!!!
MOD: Agregado funcion para marcar piel.
GRACIAS POR LEER!!!
Título: Re: [Source] Funciones para marcar contornos de una imagen y marcar piel.
Publicado por: Karcrack en 6 Diciembre 2010, 21:57 pm
Muy sexy el tio de la foto :-* :rolleyes: :xD
Interesante trabajo... pero que utilidad tiene? A parte del efecto, que se puede hacer simplemente con el Photoshop >:D :P
Título: Re: [Source] Funciones para marcar contornos de una imagen y marcar piel.
Publicado por: LeandroA en 6 Diciembre 2010, 22:40 pm
Interesante trabajo... pero que utilidad tiene? A parte del efecto, que se puede hacer simplemente con el Photoshop >:D :P
Que (http://t0.gstatic.com/images?q=tbn:MP6kwZ0TmR-RMM:http://img218.imageshack.us/img218/3885/1182556324f.jpg&t=1) jajaj sos malo cuando queres ;D
Título: Re: [Source] Funciones para marcar contornos de una imagen y marcar piel.
Publicado por: LeandroA en 6 Diciembre 2010, 22:40 pm
PD: quedo bueno el Efecto
Saludos.
Título: Re: [Source] Funciones para marcar contornos de una imagen y marcar piel.
Publicado por: 79137913 en 6 Diciembre 2010, 23:22 pm
HOLA!!!
Karcrack: La idea no es hacer un programa que haga filtros estilo photoshop la idea es reconocer a las personas por su cara.
Algo asi: (http://img98.imageshack.us/img98/8040/dibujoytg.png)
Perdon si no les agrada, solamente queria compartir.
Lo que estoy haciendo para que tengan una idea es: Traducir el programa que arme en delphi que arme para detectar rostros que aparecen en la webcam, con esas dos funciones lo que hago es fijarme con la de contorno las formas que son parecidas a las caras, y con el filtro de color piel lo que hace es eliminar todas las cosas que tienen forma de cara pero no tienen color piel :P (perdonen la redundancia). Para que se den una idea en definitiva es un programa que muestra la webcam estilo la camara esa que reconoce rostros, osea muestra un cuadrado al rededor del mismo para luego reconocerlo (la parte de reconocer los rostros es lo que me falta osea quien es).
P.D: Vuelvo a decir gracias LeandroA, pensaba que el vb6 no me iba a dar la velocidad para procesar la imagen :) .
GRACIAS POR LEER!!!
Título: Re: [Source] Funciones para marcar contornos de una imagen y marcar piel.
Publicado por: Karcrack en 6 Diciembre 2010, 23:48 pm
Solo queria saber si tenia utilidad :-[ Y por lo visto la tiene :) Me encanta el proyecto de reconocimiento facial, mucha suerte :D
Título: Re: [Source] Funciones para marcar contornos de una imagen y marcar piel.
Publicado por: LeandroA en 7 Diciembre 2010, 01:54 am
che interesante lo de reconocimiento facial (no digo de quien es la persona por que es muy muy complicado) sino de que encuentre un rostro dentro de una imagen tal como lo hacen las cámaras digitales.
me encantaría saber cual es la lógica para lograrlo, tengo mis dudas sobre el color piel ya que eso es muy complicado deducirlo según la iluminación y el color de piel de la persona.
yo a mi parecer se basa en los ojos y la nariz, hice una prueba con mi cámara y veo que no reconoce si la persona esta de perfil. de frente si te tapas la boca y la frente te reconoce igual, si te tapas la nariz o los ojos no.
si me llego a enterar de algo te aviso.
pd: ese código compilado es mucho mas rápido, igualmente nunca va a alcanzar la velocidad de C o ASM, muchos para estas cosas utiliza ASM +VB es super rápido, pero no tengo ni idea
Saludos.
Título: Re: [Source] Funciones para marcar contornos de una imagen y marcar piel.
Publicado por: LeandroA en 7 Diciembre 2010, 02:09 am
Aca esta biendo estos videos, el ultimo me mato de risa jeje, puede que tengas razon con lo de la piel
V7UdYzCMKvw
1luwH35RNBk OSgF2t15DrU
Título: Re: [Source] Funciones para marcar contornos de una imagen y marcar piel.
Publicado por: cobein en 7 Diciembre 2010, 03:52 am
Aca hay un documento muy interesante
hxxp://vision.ai.uiuc.edu/mhyang/papers/icpr04_tutorial.pdf
|