capture cam web

[LeandroA]

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 (vb) [Seleccionar] Expandir

Private Const GET_FRAME As Long = 1084
Private Const WM_USER = &H400
Private Const WM_CAP_START = WM_USER
Private Const WM_CAP_FILE_SAVEDIB = WM_CAP_START + 25


Código (vb) [Seleccionar] Expandir

Public Function GetFrameWebCam() As StdPicture
    On Error Resume Next
    Dim Nombre As String
    If mCapHwnd <> 0 Then
        Nombre = StrConv(App.Path & "\TMPfoto.bmp", vbFromUnicode)
        SendMessage mCapHwnd, GET_FRAME, ByVal 0, ByVal 0
        SendMessage mCapHwnd, WM_CAP_FILE_SAVEDIB, 0, StrPtr(Nombre)
        Set GetFrameWebCam = LoadPicture(App.Path & "\TMPfoto.bmp")
        Kill App.Path & "\TMPfoto.bmp"
    End If
End Function

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

Código (vb) [Seleccionar] Expandir

Option Explicit
Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

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 Type BITMAP
  bmType                As Long
  bmWidth               As Long
  bmHeight              As Long
  bmWidthBytes          As Long
  bmPlanes              As Integer
  bmBitsPixel           As Integer
  bmBits                As Long
End Type


Public Sub AnalizeCapture(ByVal hBmp As StdPicture)

    Dim bDib()          As Byte
    Dim X As Long, Y    As Long
    Dim xEnd            As Long
    Dim SA              As SAFEARRAY2D
    Dim tBmp            As BITMAP
    Dim R As Byte, G As Byte, B As Byte
   
    GetObjectAPI hBmp, Len(tBmp), tBmp
     
    With SA
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = tBmp.bmHeight
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = tBmp.bmWidthBytes
        .pvData = tBmp.bmBits
    End With
   
    CopyMemory ByVal VarPtrArray(bDib), VarPtr(SA), 4

    xEnd = (tBmp.bmWidth - 1) * 3
   
    For Y = 0 To tBmp.bmHeight - 1
        For X = 0 To xEnd Step 3
            B = CLng(bDib(X, Y))
            G = CLng(bDib(X + 1, Y))
            R = CLng(bDib(X + 2, Y))
           
            'Debug.Print r,g,b
        Next
    Next
             
    CopyMemory ByVal VarPtrArray(bDib), 0&, 4

End Sub



osea tendrias que llamar todo asi

Código [Seleccionar] Expandir

call AnalizeCapture(GetFrameWebCam)

y bueno despues vos hace el resto.

[<[(x)]>]

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!