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