elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Arreglado, de nuevo, el registro del warzone (wargame) de EHN


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [Source] Funciones para marcar contornos de una imagen y marcar piel.
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] 2 Ir Abajo Respuesta Imprimir
Autor Tema: [Source] Funciones para marcar contornos de una imagen y marcar piel.  (Leído 7,749 veces)
79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
[Source] Funciones para marcar contornos de una imagen y marcar piel.
« en: 6 Diciembre 2010, 14:26 pm »

HOLA!!!

EFECTO:


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!
Código
  1. Option Explicit
  2. 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
  3. Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
  4. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
  5. Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
  6. Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
  7. 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
  8. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  9. Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
  10. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  11. Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
  12.  
  13. Private Type RGBQUAD
  14.    rgbBlue As Byte
  15.    rgbGreen As Byte
  16.    rgbRed As Byte
  17.    rgbReserved As Byte
  18. End Type
  19.  
  20. Private Type BITMAPINFOHEADER
  21.    biSize As Long
  22.    biWidth As Long
  23.    biHeight As Long
  24.    biPlanes As Integer
  25.    biBitCount As Integer
  26.    biCompression As Long
  27.    biSizeImage As Long
  28.    biXPelsPerMeter As Long
  29.    biYPelsPerMeter As Long
  30.    biClrUsed As Long
  31.    biClrImportant As Long
  32. End Type
  33.  
  34. Private Type BITMAPINFO24
  35.    bmiHeader As BITMAPINFOHEADER
  36.    bmiColors() As RGBQUAD
  37. End Type
  38.  
  39. Private Type SAFEARRAYBOUND
  40.    cElements As Long
  41.    lLbound As Long
  42. End Type
  43.  
  44. Private Type SAFEARRAY2D
  45.    cDims As Integer
  46.    fFeatures As Integer
  47.    cbElements As Long
  48.    cLocks As Long
  49.    pvData As Long
  50.    Bounds(0 To 1) As SAFEARRAYBOUND
  51. End Type
  52.  
  53.  
  54. Private Const DIB_RGB_COLORS = 0
  55. Private Const BI_RGB = 0&
  56.  
  57.  
  58. Public Sub BuscarContornos(Pic As PictureBox)
  59.    Dim BytesPerLine As Long
  60.    Dim WinDC As Long
  61.    Dim TmpDC As Long
  62.    Dim hBmp As Long
  63.    Dim OldBmp As Long
  64.    Dim Addrs As Long
  65.    Dim x As Long
  66.    Dim y As Long
  67.    Dim lpBits() As Byte
  68.    Dim M_BitmapInfo As BITMAPINFO24
  69.    Dim SA As SAFEARRAY2D
  70.    Dim R As Byte, G As Byte, B As Byte, BYN As Byte, Tolerance As Byte
  71.    Dim ZERO As Integer
  72.    Dim tmp1 As Integer, tmp2 As Integer, tmp3 As Integer
  73.    Tolerance = 20
  74.    ZERO = 0
  75.    BytesPerLine = ScanAlign(Pic.ScaleWidth * 3)
  76.  
  77.    With M_BitmapInfo.bmiHeader
  78.        .biSize = Len(M_BitmapInfo.bmiHeader)
  79.        .biWidth = Pic.ScaleWidth
  80.        .biHeight = Pic.ScaleHeight
  81.        .biPlanes = 1
  82.        .biBitCount = 24
  83.        .biCompression = BI_RGB
  84.        .biSizeImage = BytesPerLine * Pic.ScaleHeight
  85.    End With
  86.  
  87.    WinDC = GetDC(0)
  88.    TmpDC = CreateCompatibleDC(WinDC)
  89.    hBmp = CreateDIBSection(WinDC, M_BitmapInfo, DIB_RGB_COLORS, Addrs, 0, 0)
  90.  
  91.    Call ReleaseDC(0, WinDC)
  92.  
  93.    With SA
  94.        .cbElements = 1
  95.        .cDims = 2
  96.        .Bounds(0).lLbound = 0
  97.        .Bounds(0).cElements = Pic.ScaleHeight
  98.        .Bounds(1).lLbound = 0
  99.        .Bounds(1).cElements = BytesPerLine
  100.        .pvData = Addrs
  101.    End With
  102.  
  103.    CopyMemory ByVal VarPtrArray(lpBits), VarPtr(SA), 4
  104.  
  105.    OldBmp = SelectObject(TmpDC, hBmp)
  106.  
  107.    Call BitBlt(TmpDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, Pic.hDC, 0, 0, vbSrcCopy)
  108.  
  109.    For y = 0 To Pic.ScaleHeight - 1
  110.        For x = 0 To (Pic.ScaleWidth * 3) - 1 Step 3
  111.  
  112.            B = lpBits(x + 2, y)
  113.            G = lpBits(x + 1, y)
  114.            R = lpBits(x, y)
  115.  
  116.  
  117.            'ZERO ES PARA QUE NO HAGA DESBORDAMIENTO
  118.            BYN = Int((ZERO + R + G + B) / 3)
  119.  
  120.            'DIBUJA EN BLANCO Y NEGRO
  121.  
  122.            lpBits(x, y) = BYN
  123.            lpBits(x + 1, y) = BYN
  124.            lpBits(x + 2, y) = BYN
  125.            If x <> 0 And y <> 0 Then
  126.            tmp1 = lpBits(x - 1, y - 1)
  127.            tmp2 = lpBits(x - 1, y)
  128.            tmp3 = lpBits(x, y - 1)
  129.            If Abs(tmp2 - tmp1) > Tolerance Or Abs(tmp3 - tmp1) > Tolerance Then
  130.                lpBits(x - 1, y - 1) = 0
  131.                lpBits(x - 2, y - 1) = 0
  132.                lpBits(x - 3, y - 1) = 0
  133.            Else
  134.                'PINTA DE NEGRO EL PIXEL POR QUE AHI HAY UN BORDE
  135.                lpBits(x - 1, y - 1) = 255
  136.                lpBits(x - 2, y - 1) = 255
  137.                lpBits(x - 3, y - 1) = 255
  138.            End If
  139.            End If
  140.        Next x
  141.    Next y
  142.  
  143.    CopyMemory ByVal VarPtrArray(lpBits), 0&, 4
  144.    Call BitBlt(Pic.hDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, TmpDC, 0, 0, vbSrcCopy)
  145.    Call DeleteObject(SelectObject(TmpDC, OldBmp))
  146.    Call DeleteDC(TmpDC)
  147.  
  148.  
  149.  
  150. End Sub
  151.  
  152. Public Sub BuscarPiel(Pic As PictureBox)
  153.    Dim BytesPerLine As Long
  154.    Dim WinDC As Long
  155.    Dim TmpDC As Long
  156.    Dim hBmp As Long
  157.    Dim OldBmp As Long
  158.    Dim Addrs As Long
  159.    Dim x As Long
  160.    Dim y As Long
  161.    Dim lpBits() As Byte
  162.    Dim M_BitmapInfo As BITMAPINFO24
  163.    Dim SA As SAFEARRAY2D
  164.    Dim R As Byte, G As Byte, B As Byte, BYN As Byte, Tolerance As Byte
  165.    Dim ZERO As Integer
  166.    Dim tmp1 As Integer, tmp2 As Integer, tmp3 As Integer
  167.    Tolerance = 20
  168.    ZERO = 0
  169.    BytesPerLine = ScanAlign(Pic.ScaleWidth * 3)
  170.  
  171.    With M_BitmapInfo.bmiHeader
  172.        .biSize = Len(M_BitmapInfo.bmiHeader)
  173.        .biWidth = Pic.ScaleWidth
  174.        .biHeight = Pic.ScaleHeight
  175.        .biPlanes = 1
  176.        .biBitCount = 24
  177.        .biCompression = BI_RGB
  178.        .biSizeImage = BytesPerLine * Pic.ScaleHeight
  179.    End With
  180.  
  181.    WinDC = GetDC(0)
  182.    TmpDC = CreateCompatibleDC(WinDC)
  183.    hBmp = CreateDIBSection(WinDC, M_BitmapInfo, DIB_RGB_COLORS, Addrs, 0, 0)
  184.  
  185.    Call ReleaseDC(0, WinDC)
  186.  
  187.    With SA
  188.        .cbElements = 1
  189.        .cDims = 2
  190.        .Bounds(0).lLbound = 0
  191.        .Bounds(0).cElements = Pic.ScaleHeight
  192.        .Bounds(1).lLbound = 0
  193.        .Bounds(1).cElements = BytesPerLine
  194.        .pvData = Addrs
  195.    End With
  196.  
  197.    CopyMemory ByVal VarPtrArray(lpBits), VarPtr(SA), 4
  198.  
  199.    OldBmp = SelectObject(TmpDC, hBmp)
  200.  
  201.    Call BitBlt(TmpDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, Pic.hDC, 0, 0, vbSrcCopy)
  202.  
  203.    For y = 0 To Pic.ScaleHeight - 1
  204.        For x = 0 To (Pic.ScaleWidth * 3) - 1 Step 3
  205.  
  206.            R = lpBits(x + 2, y)
  207.            G = lpBits(x + 1, y)
  208.            B = lpBits(x, y)
  209.  
  210.  
  211.            'ZERO ES PARA QUE NO HAGA DESBORDAMIENTO
  212.            BYN = Int((ZERO + R + G + B) / 3)
  213.  
  214.            'DIBUJA EN BLANCO Y NEGRO
  215.            If R > 168 And G > 134 And B > 94 And R < 250 And G < 235 And B < 215 Then
  216.            ' LOS PROXIMOS 3 VALORES ESPECIFICAN EL COLOR CON EL QUE SE VA A PINTAR
  217.            lpBits(x, y) = 0
  218.            lpBits(x + 1, y) = 255
  219.            lpBits(x + 2, y) = 255
  220.            Else
  221.            lpBits(x, y) = 0 ' BYN
  222.            lpBits(x + 1, y) = 0 'BYN
  223.            lpBits(x + 2, y) = 0 'BYN
  224.            End If
  225.        Next x
  226.    Next y
  227.  
  228.    CopyMemory ByVal VarPtrArray(lpBits), 0&, 4
  229.    Call BitBlt(Pic.hDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, TmpDC, 0, 0, vbSrcCopy)
  230.    Call DeleteObject(SelectObject(TmpDC, OldBmp))
  231.    Call DeleteDC(TmpDC)
  232.  
  233.  
  234.  
  235. End Sub
  236.  
  237. Private Function ScanAlign(WidthBmp As Long) As Long
  238.    ScanAlign = (WidthBmp + 3) And &HFFFFFFFC
  239. End Function
  240.  
  241.  

Para llamar la funcion:
Código
  1. Private Sub Command1_Click()
  2.    'ESTO PARA CONTORNOS
  3.    BuscarContornos PicTratamiento
  4.    'ESTO PARA PIEL
  5.    BuscarPiel PicTratamiento
  6.    PicTratamiento.Refresh
  7. End Sub
  8.  
  9. Private Sub Form_Load()
  10.    PicTratamiento.AutoRedraw = True
  11.    PicTratamiento.ScaleMode = vbPixels
  12. End Sub

P.D: El de la foto soy yo asi que no puteen.
GRACIAS POR LEER!!!


« Última modificación: 6 Diciembre 2010, 19:54 pm por 79137913 » En línea

"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

 79137913                          *Shadow Scouts Team*
Karcrack


Desconectado Desconectado

Mensajes: 2.416


Se siente observado ¬¬'


Ver Perfil
Re: [Source] Funcion para marcar contornos de una imagen.
« Respuesta #1 en: 6 Diciembre 2010, 17:06 pm »

Estaria bien poder ver una captura de como queda :P


En línea

79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
Re: [Source] Funcion para marcar contornos de una imagen.
« Respuesta #2 en: 6 Diciembre 2010, 19:15 pm »

HOLA!!!

Karcrack: Listo ahi esta la imagen :P

GRACIAS POR LEER!!!
En línea

"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

 79137913                          *Shadow Scouts Team*
ssccaann43 ©


Desconectado Desconectado

Mensajes: 792


¬¬


Ver Perfil
Re: [Source] Funcion para marcar contornos de una imagen.
« Respuesta #3 en: 6 Diciembre 2010, 19:29 pm »

Excelente
En línea

- Miguel Núñez
Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio...
"I like ^TiFa^"
79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
Re: [Source] Funciones para marcar contornos de una imagen y marcar piel.
« Respuesta #4 en: 6 Diciembre 2010, 20:02 pm »

HOLA!!!

MOD: Agregado funcion para marcar piel.

GRACIAS POR LEER!!!
En línea

"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

 79137913                          *Shadow Scouts Team*
Karcrack


Desconectado Desconectado

Mensajes: 2.416


Se siente observado ¬¬'


Ver Perfil
Re: [Source] Funciones para marcar contornos de una imagen y marcar piel.
« Respuesta #5 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
En línea

LeandroA
Moderador
***
Desconectado Desconectado

Mensajes: 760


www.leandroascierto.com


Ver Perfil WWW
Re: [Source] Funciones para marcar contornos de una imagen y marcar piel.
« Respuesta #6 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


jajaj sos malo cuando queres ;D

En línea

LeandroA
Moderador
***
Desconectado Desconectado

Mensajes: 760


www.leandroascierto.com


Ver Perfil WWW
Re: [Source] Funciones para marcar contornos de una imagen y marcar piel.
« Respuesta #7 en: 6 Diciembre 2010, 22:40 pm »

PD: quedo bueno el Efecto

Saludos.
En línea

79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
Re: [Source] Funciones para marcar contornos de una imagen y marcar piel.
« Respuesta #8 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:


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!!!


En línea

"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

 79137913                          *Shadow Scouts Team*
Karcrack


Desconectado Desconectado

Mensajes: 2.416


Se siente observado ¬¬'


Ver Perfil
Re: [Source] Funciones para marcar contornos de una imagen y marcar piel.
« Respuesta #9 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
En línea

Páginas: [1] 2 Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
marcar una opcion por defecto
Programación Visual Basic
melielectra 2 1,201 Último mensaje 8 Octubre 2006, 12:14 pm
por fraktal
Marcar Imagenes
PHP
alienmaster 0 1,520 Último mensaje 25 Noviembre 2007, 16:56 pm
por alienmaster
Marcar Leidos
Sugerencias y dudas sobre el Foro
AxXioma 5 3,442 Último mensaje 5 Mayo 2009, 20:57 pm
por el-brujo
Marcar como leido
Sugerencias y dudas sobre el Foro
WSX 2 3,109 Último mensaje 23 Octubre 2009, 00:56 am
por WSX
msconfig marcar dos procesadores para mayor velocidad
Windows
OssoH 4 2,234 Último mensaje 7 Junio 2014, 01:34 am
por OssoH
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines