¿Como Tomar una Foto con Una Web Cam en Visual Basic.NET?

1 acuchillar parquet
2 despedidas de soltero
3 flashes de estudio

Yo para Solucionar este problema lo que hago es utilizar la siguiente Clase:

Imports System.Windows.Forms
Imports System.Drawing
Public Class cCamara
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Short, ByVal lParam As Integer) As Integer
Private 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 hWndParent As Integer, ByVal nID As Integer) As Integer
Private Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Short, ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, ByVal cbVer As Integer) As Boolean
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Integer, ByVal lpString As String) As Integer

Private lwndC As Integer

Const WM_USER As Short = &H400S
Const WS_CHILD As Integer = &H40000000
Const WS_VISIBLE As Integer = &H10000000
Const WS_THICKFRAME As Integer = &H40000
Const WM_CAP_START As Short = WM_USER
Const WM_CAP_SET_CALLBACK_ERROR As Integer = WM_CAP_START + 2
Const WM_CAP_SET_CALLBACK_STATUS As Integer = WM_CAP_START + 3
Const WM_CAP_SET_CALLBACK_YIELD As Integer = WM_CAP_START + 4
Const WM_CAP_SET_CALLBACK_FRAME As Integer = WM_CAP_START + 5
Const WM_CAP_SET_CALLBACK_VIDEOSTREAM As Integer = WM_CAP_START + 6
Const WM_CAP_SET_CALLBACK_WAVESTREAM As Integer = WM_CAP_START + 7
Const WM_CAP_DRIVER_CONNECT As Integer = WM_CAP_START + 10
Const WM_CAP_EDIT_COPY As Integer = WM_CAP_START + 30
Const WM_CAP_DLG_VIDEOSOURCE As Integer = WM_CAP_START + 42
Const WM_CAP_SET_PREVIEW As Integer = WM_CAP_START + 50
Const WM_CAP_SET_PREVIEWRATE As Integer = WM_CAP_START + 52
Const WM_CAP_SET_SCALE As Integer = WM_CAP_START + 53
Const WM_CAP_SET_CALLBACK_CAPCONTROL As Integer = WM_CAP_START + 85
Const WM_CAP_END As Short = WM_CAP_SET_CALLBACK_CAPCONTROL
Const WM_CAP_DISCONNECT As Integer = 1035

Dim F As New Form

Private Function capSetCallbackOnError(ByVal lwnd As Integer, ByVal lpProc As Integer) As Boolean
capSetCallbackOnError = CBool(SendMessage(lwnd, WM_CAP_SET_CALLBACK_ERROR, 0, lpProc))
End Function
Private Function capSetCallbackOnStatus(ByVal lwnd As Integer, ByVal lpProc As Integer) As Boolean
capSetCallbackOnStatus = CBool(SendMessage(lwnd, WM_CAP_SET_CALLBACK_STATUS, 0, lpProc))
End Function
Private Function capSetCallbackOnYield(ByVal lwnd As Integer, ByVal lpProc As Integer) As Boolean
capSetCallbackOnYield = CBool(SendMessage(lwnd, WM_CAP_SET_CALLBACK_YIELD, 0, lpProc))
End Function
Private Function capSetCallbackOnFrame(ByVal lwnd As Integer, ByVal lpProc As Integer) As Boolean
capSetCallbackOnFrame = CBool(SendMessage(lwnd, WM_CAP_SET_CALLBACK_FRAME, 0, lpProc))
End Function
Private Function capSetCallbackOnVideoStream(ByVal lwnd As Integer, ByVal lpProc As Integer) As Boolean
capSetCallbackOnVideoStream = CBool(SendMessage(lwnd, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, lpProc))
End Function
Private Function capSetCallbackOnWaveStream(ByVal lwnd As Integer, ByVal lpProc As Integer) As Boolean
capSetCallbackOnWaveStream = CBool(SendMessage(lwnd, WM_CAP_SET_CALLBACK_WAVESTREAM, 0, lpProc))
End Function
Private Function capSetCallbackOnCapControl(ByVal lwnd As Integer, ByVal lpProc As Integer) As Boolean
capSetCallbackOnCapControl = CBool(SendMessage(lwnd, WM_CAP_SET_CALLBACK_CAPCONTROL, 0, lpProc))
End Function
Private Function capDriverConnect(ByVal lwnd As Integer, ByVal i As Short) As Boolean
capDriverConnect = CBool(SendMessage(lwnd, WM_CAP_DRIVER_CONNECT, i, 0))
End Function
Private Function capEditCopy(ByVal lwnd As Integer) As Boolean
capEditCopy = CBool(SendMessage(lwnd, WM_CAP_EDIT_COPY, 0, 0))
End Function
Private Function capDlgVideoSource(ByVal lwnd As Integer) As Boolean
capDlgVideoSource = CBool(SendMessage(lwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0))
End Function
Private Function capPreview(ByVal lwnd As Integer, ByVal f As Boolean) As Boolean
capPreview = CBool(SendMessage(lwnd, WM_CAP_SET_PREVIEW, CShort(f), 0))
End Function
Private Function capPreviewRate(ByVal lwnd As Integer, ByVal wMS As Short) As Boolean
capPreviewRate = CBool(SendMessage(lwnd, WM_CAP_SET_PREVIEWRATE, wMS, 0))
End Function
Private Function capPreviewScale(ByVal lwnd As Integer, ByVal f As Boolean) As Boolean
capPreviewScale = CBool(SendMessage(lwnd, WM_CAP_SET_SCALE, CShort(f), 0))
End Function
Private Function ApagarWebCam(ByVal lwnd As Integer) As Boolean
Return CBool(SendMessage(lwnd, WM_CAP_DISCONNECT, 0, 0))
End Function

Sub ActivarCamara(ByRef fmrPrincipal As Form, ByRef Conectado As Boolean, ByRef uError As Boolean)
Ventana(fmrPrincipal)
uError = False
capGetDriverDescriptionA(0, "", 100, "", 100)
If capDriverConnect(lwndC, 0) Then
capPreviewScale(lwndC, True)
capPreviewRate(lwndC, 50)
capPreview(lwndC, True)
Else
Conectado = False
ApagarWebCam(lwndC)
MessageBox.Show("El equipo no tiene camara para tomar Fotos", "Dispositivo no Encontrado", MessageBoxButtons.OK, MessageBoxIcon.Error)
uError = True
F.Close()
End If
End Sub

Private Sub Ventana(ByVal fmrPrincipal As Form)
With F
.MdiParent = fmrPrincipal
.Text = "Tomar Foto"
.ControlBox = False
.Height = 320
.Width = 360
.FormBorderStyle = FormBorderStyle.Fixed3D
.Show()
End With
lwndC = capCreateCaptureWindowA("", WS_VISIBLE Or WS_CHILD, 15, 28, 320, 242, F.Handle.ToInt32, 0)
End Sub

Sub TomarFoto(ByRef Marco As PictureBox)
Dim data As IDataObject
Dim bmap As Bitmap
capEditCopy(lwndC) ' Llama a copiar la imagen al portapapeles
data = Clipboard.GetDataObject() ' Obtiene la imagen del portapapeles
bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)), Bitmap) ' Lo comvierte a bmp
Dim CallBack As New Image.GetThumbnailImageAbort(AddressOf Imagen.MycallBack)
bmap = Imagen.Redimensionar(bmap)
Marco.DataBindings(0).DataSourceUpdateMode = DataSourceUpdateMode.OnValidation
Marco.Image = bmap ' La copia
capSetCallbackOnError(lwndC, VariantType.Null)
capSetCallbackOnStatus(lwndC, VariantType.Null)
capSetCallbackOnYield(lwndC, VariantType.Null)
capSetCallbackOnFrame(lwndC, VariantType.Null)
capSetCallbackOnVideoStream(lwndC, VariantType.Null)
capSetCallbackOnWaveStream(lwndC, VariantType.Null)
capSetCallbackOnCapControl(lwndC, VariantType.Null)
ApagarWebCam(lwndC)
F.Close()
End Sub

Public Class Imagen
Shared Function Redimensionar(ByVal Imagen As Image) As Bitmap
Dim CallBack As New Image.GetThumbnailImageAbort(AddressOf MycallBack)
Return CType(Imagen.GetThumbnailImage(130, 130, CallBack, IntPtr.Zero), Bitmap)
End Function

Shared Function MycallBack() As Boolean
Return False
End Function
End Class
End Class


Ya en el Formulario donde deseo agregar mi fotografía coloco una Control PictureBox y un Botón de la Siguiente Forma:
Private Sub btnTomar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnTomar.Click
Static Foto As Boolean
If Not Foto Then
btnExaminar.Enabled = False
TFoto = New Clases.cCamara
Dim Activado As Boolean = True
Dim uError As Boolean = False
TFoto.ActivarCamara(Me.ParentForm.ParentForm, Activado, uError)
If Activado Then
btnTomar.Text = "Capturar"
Foto = True
Else
btnTomar.Enabled = False
End If
If uError Then btnExaminar.Enabled = True
Else
TFoto.TomarFoto(pbImagenes)
TFoto = Nothing
btnTomar.Text = "Tomar"
btnExaminar.Enabled = True
Foto = False
End If
End Sub
Espero ayudar a mas de alguno, alguna pregunta solo hacerla. Hasta la Próxima