Autor
|
Tema: [Ayuda]Reconocer contornos Picturebox (Leído 3,643 veces)
|
79137913
Desconectado
Mensajes: 1.169
4 Esquinas
|
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 ) hacen un call a la funcion y listo. Public color As Long Public ElR As Byte Public ElG As Byte Public ElB As Byte Dim P12 As Integer, P21 As Integer, P22 As Integer Public Sub RGBdelPixel(x As Integer, y As Integer) color = Form1.PicTratamiento.Point(x - 1, y) ElB = (color \ 65536) And &HFF ElG = (color \ 256) And &HFF ElR = color And &HFF P12 = (70! * ElR + 150! * ElG + 29! * ElB) / 255 color = Form1.PicTratamiento.Point(x, y - 1) ElB = (color \ 65536) And &HFF ElG = (color \ 256) And &HFF ElR = color And &HFF P21 = (70! * ElR + 150! * ElG + 29! * ElB) / 255 color = Form1.PicTratamiento.Point(x, y) ElB = (color \ 65536) And &HFF ElG = (color \ 256) And &HFF ElR = color And &HFF P22 = (70! * ElR + 150! * ElG + 29! * ElB) / 255 End Sub Public Sub Contornos() Dim AltUrA As Integer, lArgO As Integer, color As Integer Dim i As Integer, j As Integer Form1.PicTratamiento.ScaleMode = 3 AltUrA = Form1.PicTratamiento.ScaleHeight lArgO = Form1.PicTratamiento.ScaleWidth tolerancia = 100 For i = 1 To lArgO - 1 For j = 1 To AltUrA - 1 RGBdelPixel i, j If Abs(P12 - P22) > tolerancia Or Abs(P21 - P22) > tolerancia Then Form1.PicTratamiento.PSet (i, j) ', RGB(P22, P22, P22) Else Form1.PicTratamiento.PSet (i, j), vbWhite End If Next Next Form1.PicTratamiento.ScaleMode = 1 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
|
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 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 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) '---------------------------------- ' 'Aca modificas el R,G,B a tu gusto ' '---------------------------------- lpBits(X, Y) = R lpBits(X + 1, Y) = G lpBits(X + 2, Y) = B 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
Private Sub Command1_Click() BuscarContornos PicTratamiento PicTratamiento.Refresh End Sub Private Sub Form_Load() PicTratamiento.AutoRedraw = True PicTratamiento.ScaleMode = vbPixels End Sub
Saludos.
|
|
|
En línea
|
|
|
|
79137913
Desconectado
Mensajes: 1.169
4 Esquinas
|
HOLA!!! Gracias LEA!!! Me ayudaste un monton, me sirve mucho gracias 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*
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
AYUDA CON EL PICTUREBOX
Programación Visual Basic
|
IvanUgu
|
3
|
2,379
|
10 Julio 2005, 02:51 am
por IvanUgu
|
|
|
ayuda con picturebox
« 1 2 »
Programación Visual Basic
|
titan6146
|
19
|
9,312
|
20 Noviembre 2009, 21:36 pm
por MCKSys Argentina
|
|
|
Ayuda con PictureBox [Vb.Net]
.NET (C#, VB.NET, ASP)
|
Keyen Night
|
1
|
5,533
|
4 Abril 2010, 00:01 am
por raul338
|
|
|
ayuda commondialog y texto en picturebox
Programación Visual Basic
|
soru13
|
0
|
1,919
|
17 Abril 2011, 20:43 pm
por soru13
|
|
|
VB.NET - Captcha a PictureBox - Ayuda porfavor
Scripting
|
ivanhack
|
0
|
3,346
|
12 Diciembre 2011, 17:36 pm
por ivanhack
|
|