Ejemplos usando el Api de windows para Visual basic

222 - Capturar la webCam

Contenido

Ejemplo 1
Ejemplo 2
Relacionados

Ejemplo 1

Ejemplo enviado por Helmuth Campos, que usa la función del api SendMessage y capCreateCaptureWindow

Nota: A la función capCreateCaptureWindow, en el anteúltimo parámetro, se le envía el Hwnd de la ventana donde se capturará la webcam , por ejemplo un picture o formulario

Ejemplo

Añadir dos Commandbutton y un control Timer

Código fuente en el formulario

Option Explicit ' Declaraciones api ''''''''''''''''''''''''''''''''''''''''''''''' Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" _ Alias "capCreateCaptureWindowA" ( _ ByVal lpszWindowName As String, _ ByVal dwStyle As Long, _ ByVal x As Long, _ ByVal y As Long, _ ByVal nWidth As Long, _ ByVal nHeight As Long, _ ByVal hwndParent As Long, _ ByVal nID As Long) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Private Declare Function DestroyWindow Lib "user32" (ByVal hndw As Long) As Boolean ' constantes y variables ''''''''''''''''''''''''''''''''''''''''''''''' Private Const CONNECT As Long = 1034 Private Const DISCONNECT As Long = 1035 Private Const GET_FRAME As Long = 1084 Private Const COPY As Long = 1054 Private hWndCap As Long 'Api para crear la ventana de captura (16 bits) 'Declare Function capCreateCaptureWindow Lib "avicap.dll" ( _ ByVal lpszWindowName As String, _ ByVal dwStyle As Long, _ ByVal x As Integer, _ ByVal y As Integer, _ ByVal nWidth As Integer, _ ByVal nHeight As Integer, _ ByVal hwndParent As Integer, _ ByVal nID As Integer) As Long ' Lo demas sirve de igual modo en win16 y 32 la diferencia que el picturebox de _ vb6 no sale la imagen saliente, sino se resiza automticamente, en vb3 lo contrario _ pueden usar un control image llamado picture1 o un picturebox llamado picture1 _ dos command button poner en el boton 1 Sub Command1_Click() Dim x As Long hWndCap = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 160, 120, Me.hwnd, 0) DoEvents x = SendMessage(hWndCap, CONNECT, 0, 0) Timer1.Enabled = True End Sub 'en el Command22 Sub Command2_Click() Dim x As Long DoEvents x = SendMessage(hWndCap, DISCONNECT, 0, 0) Timer1.Enabled = False End Sub 'en el load del formulario Private Sub Form_Load() Timer1.Enabled = False Timer1.Interval = 1 Command1.Caption = "Conectar a la webcam" Command2.Caption = "Desconectar webcam" End Sub Private Sub Form_Unload(Cancel As Integer) Dim x As Long x = DestroyWindow(hWndCap) End Sub

Ejemplo 2

Este otro código fuente también enviado por Helmuth Campos ,permite capturar la web cam en visual basic en un PictureBox y controlar algunas cosas como el formato de imagen y configuralo

Formulario

vista previa del formulario para capturar la webcam

Controles para el formulario

Un control PictureBox
Cuatro Commandbutton
Un módulo bas

Código fuente en el formulario

Option Explicit Dim temp As Long ' botón que inicia la captura ''''''''''''''''''''''''''''''''''''''' Private Sub Command1_Click() Dim temp As Long hwdc = capCreateCaptureWindow("CapWindow", ws_child Or ws_visible, _ 0, 0, 320, 240, Picture1.hwnd, 0) If (hwdc <> 0) Then temp = SendMessage(hwdc, wm_cap_driver_connect, 0, 0) temp = SendMessage(hwdc, wm_cap_set_preview, 1, 0) temp = SendMessage(hwdc, WM_CAP_SET_PREVIEWRATE, 30, 0) temp = SendMessage(hwdc, WM_CAP_SET_SCALE, True, 0) 'esto hace que la imagen recibida por el dispositivo se ajuste 'al tamaño de la ventana de captura (justo lo que yo buscaba) DoEvents startcap = True Else MsgBox "No hay Camara Web", 48, "Error" End If End Sub ' botón para detener la captura ''''''''''''''''''''''''''''''''''''''' Private Sub Command2_Click() temp = DestroyWindow(hwdc) If startcap = True Then temp = SendMessage(hwdc, WM_CAP_DRIVER_DISCONNECT, 0&, 0&) DoEvents startcap = False End If End Sub ' Botón que abre el dialogo de formato '''''''''''''''''''''''''''''''''''''''''''' Private Sub Command3_Click() If startcap = True Then temp = SendMessage(hwdc, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&) DoEvents End If End Sub ' Mostrar dialogo de Configuracion de la WebCam '''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub Command4_Click() Dim temp As Long If startcap = True Then temp = SendMessage(hwdc, WM_CAP_DLG_VIDEOCONFIG, 0&, 0&) DoEvents End If End Sub Private Sub Form_Load() Command1.Caption = "Iniciar" Command2.Caption = "Detener" Command3.Caption = "Formato" Command4.Caption = "Configurar" Me.Caption = "Capturador de Web Cam" End Sub Private Sub Form_Resize() On Error Resume Next Move (Screen.Width - Width) \ 29, (Screen.Height - Height) \ 29 End Sub Private Sub Form_Unload(Cancel As Integer) temp = DestroyWindow(hwdc) If startcap = True Then temp = SendMessage(hwdc, WM_CAP_DRIVER_DISCONNECT, 0&, 0&) DoEvents startcap = False End If End Sub

Código fuente en el módulo bas

Option Explicit ' declaraciones Api, constantes, variables '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Const ws_child = &H40000000 Public Const ws_visible = &H10000000 Public Const WM_USER = 1024 Public Const wm_cap_driver_connect = WM_USER + 10 Public Const wm_cap_set_preview = WM_USER + 50 Public Const WM_CAP_SET_PREVIEWRATE = WM_USER + 52 Public Const WM_CAP_DRIVER_DISCONNECT = WM_USER + 11 Public Const WM_CAP_DLG_VIDEOFORMAT = WM_USER + 41 Public Const WM_CAP_DLG_VIDEOCONFIG = WM_USER + 42 Public Const WM_CAP_SET_SCALE = WM_USER + 53 'Api para crear la ventana de captura Public Declare Function capCreateCaptureWindow Lib "avicap32.dll" _ Alias "capCreateCaptureWindowA" ( _ ByVal lpszWindowName As String, _ ByVal dwStyle As Long, _ ByVal x As Long, _ ByVal y As Long, _ ByVal nWidth As Long, _ ByVal nHeight As Long, _ ByVal hwndParent As Long, _ ByVal nID As Long) As Long Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Public Declare Function DestroyWindow Lib "user32" (ByVal hndw As Long) As Boolean 'Solo 16 Bits (vb2, vb3 y vb4 de 16) 'Declare Function SendMessage Lib "User" ( _ ByVal hWnd As Integer, _ ByVal wMsg As Integer, _ ByVal wParam As Integer, _ lParam As Any) As Long 'Api para crear la ventana de captura 'Declare Function capCreateCaptureWindow Lib "avicap.dll" ( _ ByVal lpszWindowName As String, _ ByVal dwStyle As Long, _ ByVal x As Integer, _ ByVal y As Integer, _ ByVal nWidth As Integer, _ ByVal nHeight As Integer, _ ByVal hwndParent As Integer, _ ByVal nID As Integer) As Long 'Declare Function DestroyWindow Lib "User" (ByVal hndw As Integer) As Integer Public hwdc As Long Public startcap As Integer

Recursos relacionados

Buscar en Recursos vb