How to use webcam capture on a Microsoft Access form?

后端 未结 1 1987
一生所求
一生所求 2021-01-23 07:45

I\'m designing a database in Microsoft Access 2013 to store records of faulty parts found in the plant.

I\'m trying to implement a button on my form the user can click t

相关标签:
1条回答
  • 2021-01-23 08:39

    I see you've had trouble adjusting the code yourself, so let me walk you through the process of adjusting it for VBA.

    First, we're going to create a form that holds the webcam code, and add the required controls to it. The controls are:

    4 buttons, called cmd1, cmd2, cmd3, and cmd4, and 1 subform control, called PicWebCam. We're using a subform to replace the PictureBox object, since that's not available in Access.

    Since the subform needs to display something, we create a second form in design view, and set record selectors and navigation buttons to No. We add no controls to the form, and make it small enough so it doesn't have scroll bars. Then, we set our subform control's source object to the form we just created.

    Then, the code also uses a CommonDialog control to let us choose a file path to save the picture. While that's available with some combinations of Windows + Access, we can't rely on that, so we'll use a FileDialog instead.

    To get a file path, we add the following code to our form module:

    Function GetSavePath() As String
        Dim f As Object 'FileDialog
        Set f = Application.FileDialog(2) 'msoFileDialogSaveAs
        If f.Show <> 0 Then GetSavePath = f.SelectedItems(1)
    End Function
    

    Then, we copy-paste the initial declarations (types and declare function statements), and make 2 adjustments:

    1. Since we're going to place them in the form module, Public needs to be removed for everything that's private by default, and changed to Private for the stuff that isn't.

    2. Since we want to be compatible with 64-bit Access (you said you didn't need to be, but adding it anyway), we want to add the PtrSafe keyword to all external functions, and change the type for all pointers from Long to LongPtr. This code comes before the function we just created.

    Const WS_CHILD As Long = &H40000000
    Const WS_VISIBLE As Long = &H10000000
    
    Const WM_USER As Long = &H400
    Const WM_CAP_START As Long = WM_USER
    
    Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10
    Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11
    Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50
    Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52
    Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_CAP_START + 41
    Const WM_CAP_FILE_SAVEDIB As Long = WM_CAP_START + 25
    
    Private Declare PtrSafe 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 LongPtr _
            , ByVal nID As Long) As Long
    
    Private Declare PtrSafe Function SendMessage Lib "user32" _
        Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long _
            , ByVal wParam As Long, ByRef lParam As Any) As Long
    
    Dim hCap As LongPtr
    

    Now, we can copy paste the actual functions, and make 2 changes:

    1. Instead of the common dialog control code, we use the GetSavePath function to get the path the user wants to save the file at.
    2. Instead of PicWebCam.hWnd, we use PicWebCam.Form.hWnd to get the hWnd for the frame we want to fill with the webcam feed.
    Private Sub cmd4_Click()
    Dim sFileName As String
        Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&)
        sFileName = GetSavePath
        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.Form.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
    

    Finally, since we added event handlers for the Form_Load event, we need to make sure the On Load property of the form is set to [Event Procedure]. The same goes for the On Click property of all command buttons we've added.

    And, that's it, we've succesfully migrated the webcam code from VB6 to VBA, and recreated the form that was sparsely described in the link you provided. Credits to most of the code go to the author on that link.

    You can temporarily download the result here. Note that I recommend you don't, both for educational purposes, and because you shouldn't trust random strangers on the internet giving you unsigned executables. But it's useful if you encounter an error, so you can check if it might be a webcam compatibility issue, or a mistake.

    Note that I haven't made any real functional changes to the original code.

    0 讨论(0)
提交回复
热议问题