[Visual Net] --> Capturar video webcam para PictureBox

Alguna vez hemos necesitado capturar una imagen, para por ejemplo asignarla a un cliente en un programa de facturación, o bien para un programa TPV para asignarla a un determinado artículo y después posteriormente cargarla en un listView.

Para esto creamos un nuevo módulo que llamaremos por ejemplo: modWebCam

En la primera línea del módulo importamos la siguiente librería: Imports System.Runtime.InteropServices

Dentro del módulo declaramos las siguients constantes:
    Const WM_CAP_START = &H400S
    Const WS_CHILD = &H40000000
    Const WS_VISIBLE = &H10000000

    Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
    Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11
    Const WM_CAP_EDIT_COPY = WM_CAP_START + 30
    Const WM_CAP_SEQUENCE = WM_CAP_START + 62
    Const WM_CAP_FILE_SAVEAS = WM_CAP_START + 23

    Const WM_CAP_SET_SCALE = WM_CAP_START + 53
    Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
    Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50

    Const SWP_NOMOVE = &H2S
    Const SWP_NOSIZE = 1
    Const SWP_NOZORDER = &H4S
    Const HWND_BOTTOM = 1

Declaramos una serie de funciones de la API de Windows:


Declaramos función que nos da la versión y la descripción del driver
 Declare Function capGetDriverDescriptionA Lib "avicap32.dll" _
       (ByVal wDriverIndex As Short, _
        ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, _
        ByVal cbVer As Integer) As Boolean

Declaramos función que crea captura de ventana
Declare Function capCreateCaptureWindowA Lib "avicap32.dll" _
       (ByVal lpszWindowName As String, ByVal dwStyle As Integer, _
        ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, _
        ByVal nHeight As Short, ByVal hWnd As Integer, _
        ByVal nID As Integer) As Integer

Declaramos función que envía mensaje a ventana
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
       (ByVal hwnd As Integer, ByVal Msg As Integer, ByVal wParam As Integer, _
       ByVal lParam As Object) As Integer

Función que ajusta la posición de la ventana en relación al buffer de la pantalla
Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" _
       (ByVal hwnd As Integer, _
        ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, _
        ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer

Función para destruir la ventana especificada
Declare Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean

Creamos nuestra funciones personalizadas
Función que captura la imagen y nos devuelve un objeto Image que podemos asociar a un Picture Box por ejemplo

Public Function CapturaImagen() As Image

        Dim data As IDataObject
        Dim bmap As Image

        Try
            '---copiamos la imagen
            SendMessage(hWnd, WM_CAP_EDIT_COPY, 0, 0)

            '---capturamos la imagen del portapapeles
            data = Clipboard.GetDataObject()
            If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
                bmap = _
                   CType(data.GetData(GetType(System.Drawing.Bitmap)),  _
                   Image)
                StopPreviewWindow()
                Return bmap
            Else
                Throw New Exception("Error intentando capturar imagen")
            End If
        Catch ex As Exception
            err("modWebCam/CapturaImagen", ex.Message)
        End Try
    End Function

Función para desconectar la entrada de Video:
 Private Sub StopPreviewWindow()
        SendMessage(hWnd, WM_CAP_DRIVER_DISCONNECT, VideoSource, 0)
        DestroyWindow(hWnd)
    End Sub

Previsualización de la entrada de video:
Private Sub PreviewVideo(ByVal pbCtrl As PictureBox)
        hWnd = capCreateCaptureWindowA(VideoSource, WS_VISIBLE Or WS_CHILD, 0, 0, 0, _
            0, pbCtrl.Handle.ToInt32, 0)

        If SendMessage(hWnd, WM_CAP_DRIVER_CONNECT, VideoSource, 0) Then
            '---set the preview scale---
            SendMessage(hWnd, WM_CAP_SET_SCALE, True, 0)
            '---set the preview rate (ms)---
            SendMessage(hWnd, WM_CAP_SET_PREVIEWRATE, 30, 0)
            '---start previewing the image---
            SendMessage(hWnd, WM_CAP_SET_PREVIEW, True, 0)
            '---resize window to fit in PictureBox control---
            SetWindowPos(hWnd, HWND_BOTTOM, 0, 0, _
               pbCtrl.Width, pbCtrl.Height, _
               SWP_NOMOVE Or SWP_NOZORDER)
        Else
            '--error connecting to video source---
            DestroyWindow(hWnd)
        End If
    End Sub

Ejemplo de uso donde llamamos a la función PreviewVideo para previsualizar la imagen de la cam en un picturebox (pcbFoto) que se encuentra en formulario (frmWebCam)

Public Sub IniciaCam()
        Try

            VideoSource = 0
            StopPreviewWindow()
            PreviewVideo(frmWebCam.pcbFoto)
            frmWebCam.ShowDialog()
        Catch ex As Exception
            err("modGeneral/IniciaCam", ex.Message)
        End Try
    End Sub