MS Access VBA代码从摄像头捕获图像并保存 [英] MS Access VBA code to capture image from camera and save it

问题描述

我想在我的表单中添加一个按钮（MS Access数据库），因此它可以从我的相机（笔记本电脑）捕获图像并将其保存在特定位置（c：\ image）。
我在办公室2010或办公室365使用Windows 10.

I want to add a button in my form(MS Access Database), so it can capture image from my camera(laptop) and save it in a specific location (c:\image). I am using windows 10 with office 2010 or 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连接）。我需要使用笔记本电脑的内置相机。

With this I manage to open my iPhone camera (usb attach). I need to use my in-build camera of my laptop.

谢谢

推荐答案

这个页面可能就是您所需要的。
http：/ /www.developerfusion.com/thread/46191/how-to-capture-picture-using-webcam-in-vb60/

This page is probably what you need. 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只有少量功能。

Basically what this is doing is using the windows message pump to send messages to web cam driver, asking it to take a picture. Also, a tip for future self help. You can often get better results by searching VB6, which is almost the exact same thing as VBA. VBA just has a few less functions.

如果缺少常用的对话框控件。您可以将代码更改为此

If you lack the common dialog control. You can change the code to this

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

这篇关于MS Access VBA代码从摄像头捕获图像并保存的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！