Захватите изображение с камеры и сохраните его

Я хочу добавить кнопку в свою форму (база данных MS Access), чтобы она могла захватывать изображение с моей камеры (ноутбука) и сохранять его в определенном месте (c:\image).

Я использую Windows 10 с Office 2010 или Office 365.

Код с WIA:

Private Sub Command1_Click()
    
    Dim oWIA_DeviceManager As WIA.DeviceManager
    Dim oWIA_Device As WIA.Device
    Dim oWIA_ComDlg As WIA.CommonDialog
    Dim oImageFile As WIA.ImageFile
    Dim i As Long
    
    Set oWIA_DeviceManager = New WIA.DeviceManager
      
    If oWIA_DeviceManager.DeviceInfos.Count > 0 Then
        Set oWIA_ComDlg = New WIA.CommonDialog
          
        ' Index the Devices property starting here at 1, not 0 .
        For i = 1 To oWIA_DeviceManager.DeviceInfos.Count
            Set oWIA_Device = oWIA_DeviceManager.DeviceInfos.Item(i).Connect
          
            ' Use this to show Acquisition CommonDialog
            Set oImageFile = oWIA_ComDlg.ShowAcquireImage
              
            ' Use this to show Acquisition Wizard
            'Set oImageFile = oWIA_ComDlg.ShowAcquisitionWizard(oWIA_Device)
    
        Next i
    Else
        MsgBox "No WIA compatible device attached!"
    End If
      
End Sub

При этом я открываю камеру iPhone (подключение USB). Мне нужно использовать встроенную камеру моего ноутбука.


person YvetteLee    schedule 12.05.2017    source источник


Ответы (2)


Эта страница, вероятно, то, что вам нужно. http://www.developerfusion.com/thread/46191/how-to-capture-picture-using-webcam-in-vb60/

'******************* module code **************

Public Const WS_CHILD As Long = &H40000000
Public Const WS_VISIBLE As Long = &H10000000


Public Const WM_USER As Long = &H400
Public Const WM_CAP_START As Long = WM_USER


Public Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10
Public Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11
Public Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50
Public Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52
Public Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_CAP_START + 41
Public Const WM_CAP_FILE_SAVEDIB As Long = WM_CAP_START + 25






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, ByRef lParam As Any) As Long


'************* end of module code ******************

Add the following controls in a form

1. A picture box with name "PicWebCam"

2. A commondialog control with name "CDialog"

3. Add 4 command buttons with name "cmd1","cmd2,"cmd3","cmd4"

then paste the following code

'************************** Code **************

Dim hCap As Long
Private Sub cmd4_Click()
Dim sFileName As String
    Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&)
    With CDialog
        .CancelError = True
        .Flags = cdlOFNPathMustExist Or cdlOFNOverwritePrompt
        .Filter = "Bitmap Picture(*.bmp)|*.bmp|JPEG Picture(*.jpg)|*.jpg|All Files|*.*"
        .ShowSave
        sFileName = .FileName









    End With
    Call SendMessage(hCap, WM_CAP_FILE_SAVEDIB, 0&, ByVal CStr(sFileName))
DoFinally:
    Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
End Sub




Private Sub Cmd3_Click()
Dim temp As Long
temp = SendMessage(hCap, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
End Sub


Private Sub Cmd1_Click()
hCap = capCreateCaptureWindow("Take a Camera Shot", WS_CHILD Or WS_VISIBLE, 0, 0, PicWebCam.Width, PicWebCam.Height, PicWebCam.hWnd, 0)
    If hCap <> 0 Then
        Call SendMessage(hCap, WM_CAP_DRIVER_CONNECT, 0, 0)
        Call SendMessage(hCap, WM_CAP_SET_PREVIEWRATE, 66, 0&)
        Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
    End If
End Sub






Private Sub Cmd2_Click()
Dim temp As Long
temp = SendMessage(hCap, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
End Sub


Private Sub Form_Load()
cmd1.Caption = "Start &Cam"
cmd2.Caption = "&Format Cam"
cmd3.Caption = "&Close Cam"
cmd4.Caption = "&Save Image"
End Sub
'**************** Code end ************************

В основном то, что это делает, использует насос сообщений Windows для отправки сообщений драйверу веб-камеры с просьбой сделать снимок. Кроме того, совет для будущей самопомощи. Вы часто можете получить лучшие результаты, выполняя поиск в VB6, что почти то же самое, что и VBA. VBA просто имеет несколько меньше функций.

Если вам не хватает общего управления диалогом. Вы можете изменить код на этот

Private Sub cmd4_Click()
Dim sFileName As String
    Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&)
    sFileName="C:\PathToNewImageFile.bmp"
    Call SendMessage(hCap, WM_CAP_FILE_SAVEDIB, 0&, ByVal CStr(sFileName))
DoFinally:
    Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
End Sub
person Trevor    schedule 12.05.2017
comment
Спасибо за ваш ответ. У меня проблема с 2. Элементом управления commondialog с именем CDialog. Где я могу найти его в Access 2007? - person YvetteLee; 14.05.2017
comment
Нажмите на меню инструментов. Затем Дополнительные элементы управления. Найдите элемент управления Microsoft Common Dialog. И отметьте это. Затем нажмите «ОК», и в вашем наборе инструментов появится новый элемент. Нарисуйте это на своей пользовательской форме, чтобы добавить, затем щелкните по нему внизу, чтобы вызвать свойства и дать ему имя. Тем не менее, я пытался сделать это в своем Excel 2013, но не смог, так что да... скрестим пальцы, иначе для этого нам придется использовать Windows API. Похоже, он используется только для указания места сохранения. Вы можете жестко закодировать это как тест, если хотите. Ответ обновлен - person Trevor; 15.05.2017
comment
Настройка, которую мне пришлось выполнить для базы данных Access, описанная в stackoverflow.com/questions/56757965/ - person June7; 23.10.2020

В прошлом я использовал WIA (Microsoft Windows Image Acquisition) для сканеров, но он будет работать и с веб-камерами. Я бы обязательно попробовал.

person supajason    schedule 13.05.2017
comment
Как вы думаете, он будет работать с камерой моего ноутбука? У вас есть код для тестирования? Спасибо заранее. - person YvetteLee; 14.05.2017