Foro de elhacker.net

Programación => Programación Visual Basic => Mensaje iniciado por: <[(x)]> en 20 Febrero 2010, 06:07 am


Título: capture cam web
Publicado por: <[(x)]> en 20 Febrero 2010, 06:07 am



hola quiero capturar imagenes de la camara web de mi notebook...

ya tengo un codigo pero usa la funcion sendmessage y hace pasar la imagenes capturadas por el clipboard.  :-\

les agradeceria mucho si me alcanzasen un codigo q no use este mismo metodo.

Título: Re: capture cam web
Publicado por: seba123neo en 21 Febrero 2010, 01:25 am
probaste esto ?

Capturar la webCam  (http://www.recursosvisualbasic.com.ar/htm/listado-api/222-capturar-webcam-con-sendmessage-capCreateCaptureWindow.htm)


Título: Re: capture cam web
Publicado por: <[(x)]> en 21 Febrero 2010, 18:18 pm
 :o

busque un monton no puedo creer q me haya olvidado de esa pagina  :P


el primero esta incompleto y es como decia yo pero el segundo esta perfecto muchas gracias ;-)

Título: Re: capture cam web
Publicado por: <[(x)]> en 21 Febrero 2010, 19:13 pm
unm seba123neo problemaa :P


cundo quiero:
Código
  1. Private Sub Timer1_Timer()
  2. Dim x As Integer
  3. Dim y As Integer
  4. For x = 0 To 480 / 10
  5.  For y = 0 To 640 / 10
  6.   Me.BackColor = GetPixel(Picture1.hdc, x, y)
  7.  Next
  8. Next
  9. End Sub

el color que saca getpixel es siempre el background del dc delpicture

Título: Re: capture cam web
Publicado por: seba123neo en 21 Febrero 2010, 19:15 pm
que queres hacer?

Título: Re: capture cam web
Publicado por: <[(x)]> en 21 Febrero 2010, 19:17 pm
 mmm es complejo ya se como lo voi a hacer nose si se tildara mucho desp lo paso a c++...

en fin lo que quiero es poder por ejemplo encontrar un punto de tal color en la imagen y ver donde esta (x,y) y con eso pordria hacer muchas cositas  :P como identificar formas...
pero bue
primero lo primero no? je


poriams decirme como puedo hacer?

Título: Re: capture cam web
Publicado por: seba123neo en 21 Febrero 2010, 20:13 pm
proba algo asi:

Código
  1. Option Explicit
  2.  
  3. Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
  4. Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
  5.  
  6. Private Sub Command1_Click()
  7.  
  8.     Dim vEscalaForm As Integer, vPicEscala As Integer
  9.     Dim X As Long, Y As Long, vAlto As Long, vAncho As Long
  10.  
  11.     vEscalaForm = Me.ScaleMode
  12.     vPicEscala = Picture1.ScaleMode
  13.  
  14.     Me.ScaleMode = 3
  15.     Picture1.ScaleMode = 3
  16.  
  17.     vAncho = Picture1.width
  18.     vAlto = Picture1.height
  19.  
  20.     Me.Cls
  21.  
  22.     For X = 0 To vAncho
  23.         For Y = 0 To vAlto
  24.             If Picture1.Point(X, Y) = 6522062 Then
  25.                 SetPixelV Me.hdc, X, Y, GetPixel(Picture1.hdc, X, Y)
  26.             End If
  27.             DoEvents
  28.         Next
  29.         DoEvents
  30.     Next
  31.  
  32.     Me.ScaleMode = vEscalaForm
  33.     Picture1.ScaleMode = vPicEscala
  34. End Sub
  35.  
  36. Private Sub Form_Load()
  37.     With Picture1
  38.         .AutoSize = True
  39.         .Picture = LoadPicture(Environ("windir") & "\Santa Fe.bmp")
  40.     End With
  41. End Sub

esto hace como un escaneo de los pixeles de la imagen y va sacando el color de ese pixel escaneado, con un simple if podes sacar los colores que te interesen y volcarlos en otro lado, por ejemplo aca se saca un determinado color y vuelca "solo ese color" en el formulario...

saludos. 

Título: Re: capture cam web
Publicado por: <[(x)]> en 21 Febrero 2010, 22:30 pm


jojo muy bueno  :P... solo q ese codigo es el q estoy probando y no me saca el color del pixel..

probe con picture.point(x,y), getpixel recorriendo la imagen con el for anidado y no hace mas q darme en todos los pixeles un mismo color el de  backgound  :-\.


te dejo lo que copypaste hasta ahora   :silbar:
form1
Código
  1. Option Explicit
  2. Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  3. Dim temp As Long
  4.  
  5. ' botón que inicia la captura
  6. '''''''''''''''''''''''''''''''''''''''
  7. Private Sub Command1_Click()
  8. Dim temp As Long
  9.  
  10.   hwdc = capCreateCaptureWindow("CapWindow", ws_child Or ws_visible, _
  11.                                     0, 0, 320, 240, Picture1.hwnd, 0)
  12.   If (hwdc <> 0) Then
  13.     temp = SendMessage(hwdc, wm_cap_driver_connect, 0, 0)
  14.     temp = SendMessage(hwdc, wm_cap_set_preview, 1, 0)
  15.     temp = SendMessage(hwdc, WM_CAP_SET_PREVIEWRATE, 30, 0)
  16.     temp = SendMessage(hwdc, WM_CAP_SET_SCALE, True, 0)
  17.     'esto hace que la imagen recibida por el dispositivo se ajuste
  18.     'al tamaño de la ventana de captura (justo lo que yo buscaba)
  19.     DoEvents
  20.     startcap = True
  21.     Else
  22.     MsgBox "No hay Camara Web", 48, "Error"
  23.   End If
  24.  
  25. End Sub
  26.  
  27. ' botón para detener la captura
  28. '''''''''''''''''''''''''''''''''''''''
  29. Private Sub Command2_Click()
  30.  
  31.     temp = DestroyWindow(hwdc)
  32.     If startcap = True Then
  33.         temp = SendMessage(hwdc, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
  34.         DoEvents
  35.         startcap = False
  36.     End If
  37.  
  38. End Sub
  39.  
  40. ' Botón que abre el dialogo de formato
  41. ''''''''''''''''''''''''''''''''''''''''''''
  42. Private Sub Command3_Click()
  43.         If startcap = True Then
  44.  
  45.             temp = SendMessage(hwdc, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
  46.             DoEvents
  47.         End If
  48. End Sub
  49. ' Mostrar dialogo de Configuracion de la WebCam
  50. ''''''''''''''''''''''''''''''''''''''''''''''''''''
  51. Private Sub Command4_Click()
  52.  Dim temp As Long
  53.     If startcap = True Then
  54.         temp = SendMessage(hwdc, WM_CAP_DLG_VIDEOCONFIG, 0&, 0&)
  55.         DoEvents
  56.     End If
  57. End Sub
  58.  
  59. Private Sub Form_Load()
  60.     Command1.Caption = "Iniciar"
  61.     Command2.Caption = "Detener"
  62.     Command3.Caption = "Formato"
  63.     Command4.Caption = "Configurar"
  64.     Me.Caption = "Capturador de Web Cam"
  65. End Sub
  66.  
  67. Private Sub Form_Resize()
  68.     On Error Resume Next
  69.     Move (Screen.Width - Width) \ 29, (Screen.Height - Height) \ 29
  70. End Sub
  71.  
  72. Private Sub Form_Unload(Cancel As Integer)
  73.  
  74.     temp = DestroyWindow(hwdc)
  75.     If startcap = True Then
  76.         temp = SendMessage(hwdc, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
  77.         DoEvents
  78.         startcap = False
  79.     End If
  80. End Sub
  81.  
  82.  
  83.  
  84. Private Sub Timer1_Timer()
  85. Dim x As Integer
  86. Dim y As Integer
  87. For x = 0 To 480 / 10
  88.  For y = 0 To 640 / 10
  89.   Me.BackColor = Picture1.Point(x, y)
  90.  Next
  91. Next
  92. End Sub
  93.  

modulo
Código
  1. Option Explicit
  2. ' declaraciones Api, constantes, variables
  3. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  4. Public Const ws_child = &H40000000
  5. Public Const ws_visible = &H10000000
  6. Public Const WM_USER = 1024
  7. Public Const wm_cap_driver_connect = WM_USER + 10
  8. Public Const wm_cap_set_preview = WM_USER + 50
  9. Public Const WM_CAP_SET_PREVIEWRATE = WM_USER + 52
  10. Public Const WM_CAP_DRIVER_DISCONNECT = WM_USER + 11
  11. Public Const WM_CAP_DLG_VIDEOFORMAT = WM_USER + 41
  12. Public Const WM_CAP_DLG_VIDEOCONFIG = WM_USER + 42
  13. Public Const WM_CAP_SET_SCALE = WM_USER + 53
  14.  
  15. 'Api para crear la ventana de captura
  16. Public Declare Function capCreateCaptureWindow Lib "avicap32.dll" _
  17.     Alias "capCreateCaptureWindowA" ( _
  18.     ByVal lpszWindowName As String, _
  19.     ByVal dwStyle As Long, _
  20.     ByVal x As Long, _
  21.     ByVal y As Long, _
  22.     ByVal nWidth As Long, _
  23.     ByVal nHeight As Long, _
  24.     ByVal hwndParent As Long, _
  25.     ByVal nID As Long) As Long
  26.  
  27. Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
  28.     ByVal hwnd As Long, _
  29.     ByVal wMsg As Long, _
  30.     ByVal wParam As Long, _
  31.     lParam As Any) As Long
  32.  
  33. Public Declare Function DestroyWindow Lib "user32" (ByVal hndw As Long) As Boolean
  34. 'Solo 16 Bits (vb2, vb3 y vb4  de 16)
  35. 'Declare Function SendMessage Lib "User" ( _
  36.     ByVal hWnd As Integer, _
  37.     ByVal wMsg As Integer, _
  38.     ByVal wParam As Integer, _
  39.     lParam As Any) As Long
  40. 'Api para crear la ventana de captura
  41. 'Declare Function capCreateCaptureWindow Lib "avicap.dll" ( _
  42.     ByVal lpszWindowName As String, _
  43.     ByVal dwStyle As Long, _
  44.     ByVal x As Integer, _
  45.     ByVal y As Integer, _
  46.     ByVal nWidth As Integer, _
  47.     ByVal nHeight As Integer, _
  48.     ByVal hwndParent As Integer, _
  49.     ByVal nID As Integer) As Long
  50. 'Declare Function DestroyWindow Lib "User" (ByVal hndw As Integer) As Integer
  51. Public hwdc As Long
  52. Public startcap As Integer
  53.  
  54.  
  55.  



Título: Re: capture cam web
Publicado por: el_c0c0 en 22 Febrero 2010, 02:44 am
sabes lo que pasa, intenta hacer bitblt al picture donde tenes la captura y pintarlo en otro picture, fijate que te va a quedar negro o del color de fondo del picture de la captura. tenes que usar otro metodo, donde puedas obtener la imagen.

nose si me entendiste, pero con eso, por lo menos yo, no podia obtener la foto de la webcam, era imposible. habia que buscar otro metodo como el del clipobard o otro que habia hecho cobein (que no recuerdo si usaba el clipboard)

saludos

Título: Re: capture cam web
Publicado por: <[(x)]> en 22 Febrero 2010, 04:07 am



jeje se coco eso es lo que quiero .. si alguien conoce un metodo q funcione y nouse el clipboard ;-)

Título: Re: capture cam web
Publicado por: LeandroA en 22 Febrero 2010, 04:09 am
yo uso esto no es lo mejor porque guarda la imagen en un archivo y depues la lee nuevamente, pero es mejor que el portapapeles.

Código
  1. Private Const GET_FRAME As Long = 1084
  2. Private Const WM_USER = &H400
  3. Private Const WM_CAP_START = WM_USER
  4. Private Const WM_CAP_FILE_SAVEDIB = WM_CAP_START + 25
  5.  

Código
  1. Public Function GetFrameWebCam() As StdPicture
  2.     On Error Resume Next
  3.     Dim Nombre As String
  4.     If mCapHwnd <> 0 Then
  5.         Nombre = StrConv(App.Path & "\TMPfoto.bmp", vbFromUnicode)
  6.         SendMessage mCapHwnd, GET_FRAME, ByVal 0, ByVal 0
  7.         SendMessage mCapHwnd, WM_CAP_FILE_SAVEDIB, 0, StrPtr(Nombre)
  8.         Set GetFrameWebCam = LoadPicture(App.Path & "\TMPfoto.bmp")
  9.         Kill App.Path & "\TMPfoto.bmp"
  10.     End If
  11. End Function

despues para la rutina de analizar la imagen utilizo esto metodo que es mucho mas rapido que usar getpixel

Código
  1. Option Explicit
  2. Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
  3. Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  4. Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
  5. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
  6.  
  7. Private Type SAFEARRAYBOUND
  8.     cElements           As Long
  9.     lLbound             As Long
  10. End Type
  11.  
  12. Private Type SAFEARRAY2D
  13.     cDims               As Integer
  14.     fFeatures           As Integer
  15.     cbElements          As Long
  16.     cLocks              As Long
  17.     pvData              As Long
  18.     Bounds(0 To 1)      As SAFEARRAYBOUND
  19. End Type
  20.  
  21. Private Type BITMAP
  22.   bmType                As Long
  23.   bmWidth               As Long
  24.   bmHeight              As Long
  25.   bmWidthBytes          As Long
  26.   bmPlanes              As Integer
  27.   bmBitsPixel           As Integer
  28.   bmBits                As Long
  29. End Type
  30.  
  31.  
  32. Public Sub AnalizeCapture(ByVal hBmp As StdPicture)
  33.  
  34.     Dim bDib()          As Byte
  35.     Dim X As Long, Y    As Long
  36.     Dim xEnd            As Long
  37.     Dim SA              As SAFEARRAY2D
  38.     Dim tBmp            As BITMAP
  39.     Dim R As Byte, G As Byte, B As Byte
  40.  
  41.     GetObjectAPI hBmp, Len(tBmp), tBmp
  42.  
  43.     With SA
  44.         .cbElements = 1
  45.         .cDims = 2
  46.         .Bounds(0).lLbound = 0
  47.         .Bounds(0).cElements = tBmp.bmHeight
  48.         .Bounds(1).lLbound = 0
  49.         .Bounds(1).cElements = tBmp.bmWidthBytes
  50.         .pvData = tBmp.bmBits
  51.     End With
  52.  
  53.     CopyMemory ByVal VarPtrArray(bDib), VarPtr(SA), 4
  54.  
  55.     xEnd = (tBmp.bmWidth - 1) * 3
  56.  
  57.     For Y = 0 To tBmp.bmHeight - 1
  58.         For X = 0 To xEnd Step 3
  59.             B = CLng(bDib(X, Y))
  60.             G = CLng(bDib(X + 1, Y))
  61.             R = CLng(bDib(X + 2, Y))
  62.  
  63.             'Debug.Print r,g,b
  64.         Next
  65.     Next
  66.  
  67.     CopyMemory ByVal VarPtrArray(bDib), 0&, 4
  68.  
  69. End Sub
  70.  


osea tendrias que llamar todo asi

Código:
call AnalizeCapture(GetFrameWebCam)

y bueno despues vos hace el resto.

Título: Re: capture cam web
Publicado por: <[(x)]> en 22 Febrero 2010, 04:14 am

hola  LeandroA voy a probar en una de esas locas casualidades va..jaja


el codigo que hice es para detectar una forma y ver como se mueve con la camara tendria q ser muy rapido.. si alguien tiene algomas directo gracias!


Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines