Member 12604208 Ответов: 1

Как захватить изображение в веб-камеру и отобразить в поле изображения с помощью языка VB в visual stdudio 2008

Я использую visual studio 2008, а язык-vb. Поэтому я хочу снимать фотографии клиентов с помощью веб-камеры и отображать их в PictureBox.
Я пытаюсь, но не могу добиться успеха.
Пожалуйста, дайте решение с кодом.

Что я уже пробовал:

Я пробовал решения, предложенные друзьями, но пока безуспешно.

Richard Deeming

Репост
Вы уже опубликовали этот вопрос:
https://www.codeproject.com/Questions/1209567/How-to-capture-image-by-webcam-and-display-into-pi[^]

1 Ответов

Рейтинг:
0

Lockwood

Это боль в заднице, чтобы сделать.

Я использую это, которое я нашел либо здесь, либо на SO.

#Region "Avi Cap API"
    Const WM_CAP As Short = &H400S

    Const WM_CAP_DRIVER_CONNECT As Integer = WM_CAP + 10
    Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_CAP + 11
    Const WM_CAP_EDIT_COPY As Integer = WM_CAP + 30

    Const WM_CAP_SETworkingcustomerREVIEW As Integer = WM_CAP + 50
    Const WM_CAP_SETworkingcustomerREVIEWRATE As Integer = WM_CAP + 52
    Const WM_CAP_SET_SCALE As Integer = WM_CAP + 53
    Const WS_CHILD As Integer = &H40000000
    Const WS_VISIBLE As Integer = &H10000000
    Const SWP_NOMOVE As Short = &H2
    Const SWP_NOSIZE As Short = &H1
    Const SWP_NOZORDER As Short = &H4
    Const SWP_SHOWWINDOW As Long = &H40
    Const SWP_HIDEWINDOW As Long = &H80
    Const HWND_BOTTOM As Short = 1

    Dim iDevice As Integer = 0 ' Current device ID
    Dim hHwnd As Integer ' Handle to preview window

    Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, _
        ByVal lParam As IntPtr) As Integer
    '<MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Integer

    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

    Declare Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean

    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

    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
#End Region

#Region "Webcam"
    Private Sub LoadDeviceList()
        Dim strName As String = Space(100)
        Dim strVer As String = Space(100)
        Dim bReturn As Boolean
        Dim x As Integer = -1
        Do
            bReturn = capGetDriverDescriptionA(x, strName, 100, strVer, 100)
            If bReturn Then
                iDevice = 0
                Exit Do
            End If
        Loop Until bReturn = False
    End Sub

    Private Sub OpenPreviewWindow()
        Dim iHeight As Integer = picCapture.Height
        Dim iWidth As Integer = picCapture.Width
        hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, 480, picCapture.Handle.ToInt32, 0)
        If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0) Then
            SendMessage(hHwnd, WM_CAP_SET_SCALE, True, 0)
            SendMessage(hHwnd, WM_CAP_SETworkingcustomerREVIEWRATE, 33, 0)
            SendMessage(hHwnd, WM_CAP_SETworkingcustomerREVIEW, True, 0)
            SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, picCapture.Width, picCapture.Height, SWP_NOMOVE Or SWP_NOZORDER)
            'btnSave.Enabled = True
        Else
            DestroyWindow(hHwnd)

            'btnSave.Enabled = False
        End If
    End Sub

    Private Sub ClosePreviewWindow()
        SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, iDevice, 0)
        DestroyWindow(hHwnd)
    End Sub
#End Region

Sub TakePhoto
  Dim data As IDataObject
        Dim bmap As Image
        SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)
        data = Clipboard.GetDataObject()
        If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
            bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)), Image)
'Do stuff here
        End If
End Sub