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

 

 


Tema destacado: AIO elhacker.NET 2021 Compilación herramientas análisis y desinfección malware


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [Ayuda]Reconocer contornos Picturebox
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Ayuda]Reconocer contornos Picturebox  (Leído 3,643 veces)
79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
[Ayuda]Reconocer contornos Picturebox
« en: 3 Diciembre 2010, 16:14 pm »

HOLA!!!

Como andan?, hoy tengo una duda, estoy intentando encontrar los contornos de los objetos de una foto(en un picturebox) logre armar algo buscando en google, pero es  muy inpresiso.

La imagen se trata en un Picturebox chico asi no tarda mucho, sino se come el procesador.

Si encuentran algo o ven algo en mi codigo avisenme.

Bueno, les dejo mi codigo para que lo vean.
Esto va en un modulo y en el Form1 ponen un picturebox con una imagen (chica :P) hacen un call a la funcion y listo.
Código
  1. Public color As Long
  2. Public ElR As Byte
  3. Public ElG As Byte
  4. Public ElB As Byte
  5. Dim P12 As Integer, P21 As Integer, P22 As Integer
  6.  
  7. Public Sub RGBdelPixel(x As Integer, y As Integer)
  8.   color = Form1.PicTratamiento.Point(x - 1, y)
  9.   ElB = (color \ 65536) And &HFF
  10.   ElG = (color \ 256) And &HFF
  11.   ElR = color And &HFF
  12.   P12 = (70! * ElR + 150! * ElG + 29! * ElB) / 255
  13.   color = Form1.PicTratamiento.Point(x, y - 1)
  14.   ElB = (color \ 65536) And &HFF
  15.   ElG = (color \ 256) And &HFF
  16.   ElR = color And &HFF
  17.   P21 = (70! * ElR + 150! * ElG + 29! * ElB) / 255
  18.   color = Form1.PicTratamiento.Point(x, y)
  19.   ElB = (color \ 65536) And &HFF
  20.   ElG = (color \ 256) And &HFF
  21.   ElR = color And &HFF
  22.   P22 = (70! * ElR + 150! * ElG + 29! * ElB) / 255
  23. End Sub
  24.  
  25. Public Sub Contornos()
  26. Dim AltUrA As Integer, lArgO As Integer, color As Integer
  27. Dim i As Integer, j As Integer
  28. Form1.PicTratamiento.ScaleMode = 3
  29. AltUrA = Form1.PicTratamiento.ScaleHeight
  30. lArgO = Form1.PicTratamiento.ScaleWidth
  31. tolerancia = 100
  32.  
  33. For i = 1 To lArgO - 1
  34.    For j = 1 To AltUrA - 1
  35.        RGBdelPixel i, j
  36.        If Abs(P12 - P22) > tolerancia Or Abs(P21 - P22) > tolerancia Then
  37.            Form1.PicTratamiento.PSet (i, j) ', RGB(P22, P22, P22)
  38.        Else
  39.            Form1.PicTratamiento.PSet (i, j), vbWhite
  40.        End If
  41. Next
  42. Next
  43. Form1.PicTratamiento.ScaleMode = 1
  44. End Sub

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*
LeandroA
Moderador
***
Desconectado Desconectado

Mensajes: 760


www.leandroascierto.com


Ver Perfil WWW
Re: [Ayuda]Reconocer contornos Picturebox
« Respuesta #1 en: 3 Diciembre 2010, 17:17 pm »

Hola no entiendo bien lo que queres hacer pero te paso una rutina 100 veces mas rapida para trabjar con pixels

fijate que te marque con un comentario donde tens que trata el RGB

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
  71.  
  72.    BytesPerLine = ScanAlign(Pic.ScaleWidth * 3)
  73.  
  74.    With M_BitmapInfo.bmiHeader
  75.        .biSize = Len(M_BitmapInfo.bmiHeader)
  76.        .biWidth = Pic.ScaleWidth
  77.        .biHeight = Pic.ScaleHeight
  78.        .biPlanes = 1
  79.        .biBitCount = 24
  80.        .biCompression = BI_RGB
  81.        .biSizeImage = BytesPerLine * Pic.ScaleHeight
  82.    End With
  83.  
  84.    WinDC = GetDC(0)
  85.    TmpDC = CreateCompatibleDC(WinDC)
  86.    hBmp = CreateDIBSection(WinDC, M_BitmapInfo, DIB_RGB_COLORS, Addrs, 0, 0)
  87.  
  88.    Call ReleaseDC(0, WinDC)
  89.  
  90.    With SA
  91.        .cbElements = 1
  92.        .cDims = 2
  93.        .Bounds(0).lLbound = 0
  94.        .Bounds(0).cElements = Pic.ScaleHeight
  95.        .Bounds(1).lLbound = 0
  96.        .Bounds(1).cElements = BytesPerLine
  97.        .pvData = Addrs
  98.    End With
  99.  
  100.    CopyMemory ByVal VarPtrArray(lpBits), VarPtr(SA), 4
  101.  
  102.    OldBmp = SelectObject(TmpDC, hBmp)
  103.  
  104.    Call BitBlt(TmpDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, Pic.hDC, 0, 0, vbSrcCopy)
  105.  
  106.    For Y = 0 To Pic.ScaleHeight - 1
  107.        For X = 0 To (Pic.ScaleWidth * 3) - 1 Step 3
  108.  
  109.            B = lpBits(X + 2, Y)
  110.            G = lpBits(X + 1, Y)
  111.            R = lpBits(X, Y)
  112.  
  113.            '----------------------------------
  114.            '
  115.            'Aca modificas el R,G,B a tu gusto
  116.            '
  117.            '----------------------------------
  118.  
  119.            lpBits(X, Y) = R
  120.            lpBits(X + 1, Y) = G
  121.            lpBits(X + 2, Y) = B
  122.  
  123.        Next X
  124.    Next Y
  125.  
  126.    CopyMemory ByVal VarPtrArray(lpBits), 0&, 4
  127.    Call BitBlt(Pic.hDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, TmpDC, 0, 0, vbSrcCopy)
  128.    Call DeleteObject(SelectObject(TmpDC, OldBmp))
  129.    Call DeleteDC(TmpDC)
  130.  
  131.  
  132.  
  133. End Sub
  134.  
  135. Private Function ScanAlign(WidthBmp As Long) As Long
  136.    ScanAlign = (WidthBmp + 3) And &HFFFFFFFC
  137. End Function
  138.  
Código
  1. Private Sub Command1_Click()
  2.    BuscarContornos PicTratamiento
  3.    PicTratamiento.Refresh
  4. End Sub
  5.  
  6. Private Sub Form_Load()
  7.    PicTratamiento.AutoRedraw = True
  8.    PicTratamiento.ScaleMode = vbPixels
  9. End Sub


Saludos.


En línea

79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
Re: [Ayuda]Reconocer contornos Picturebox
« Respuesta #2 en: 6 Diciembre 2010, 11:48 am »

HOLA!!!

 ;-) ;-) ;-) ;-) ;-)

Gracias LEA!!!
Me ayudaste un monton, me sirve mucho gracias :D

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*
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
AYUDA CON EL PICTUREBOX
Programación Visual Basic
IvanUgu 3 2,379 Último mensaje 10 Julio 2005, 02:51 am
por IvanUgu
ayuda con picturebox « 1 2 »
Programación Visual Basic
titan6146 19 9,312 Último mensaje 20 Noviembre 2009, 21:36 pm
por MCKSys Argentina
Ayuda con PictureBox [Vb.Net]
.NET (C#, VB.NET, ASP)
Keyen Night 1 5,533 Último mensaje 4 Abril 2010, 00:01 am
por raul338
ayuda commondialog y texto en picturebox
Programación Visual Basic
soru13 0 1,919 Último mensaje 17 Abril 2011, 20:43 pm
por soru13
VB.NET - Captcha a PictureBox - Ayuda porfavor
Scripting
ivanhack 0 3,346 Último mensaje 12 Diciembre 2011, 17:36 pm
por ivanhack
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines