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
 

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

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
 

call AnalizeCapture(GetFrameWebCam)