如何在 Microsoft Access 表单上使用网络摄像头捕获?
How to use webcam capture on a Microsoft Access form?
我正在 Microsoft Access 2013 中设计一个数据库来存储工厂中发现的故障部件的记录。
我正在尝试在我的表单上实现一个按钮,用户可以单击该按钮来访问他们设备的摄像头,以在表单中附加故障图片。用户在戴尔 Latitude 5290 二合一设备上使用 Windows 10。
我尝试了在网上找到的代码,但它非常旧。 https://www.developerfusion.com/thread/46191/how-to-capture-picture-using-webcam-in-vb60/
我发现您在自己调整代码时遇到了问题,所以让我向您介绍一下 VBA 的调整过程。
首先,我们将创建一个包含网络摄像头代码的表单,并向其中添加所需的控件。控件是:
4 个按钮,分别称为 cmd1、cmd2、cmd3 和 cmd4,以及 1 个子窗体控件,称为 PicWebCam。我们正在使用子窗体替换 PictureBox 对象,因为它在 Access 中不可用。
由于子窗体需要显示一些东西,我们在设计视图中创建第二个窗体,并将记录选择器和导航按钮设置为否。我们不向窗体添加任何控件,并将其设置得足够小,因此它不会有滚动条。然后,我们将子表单控件的源对象设置为我们刚刚创建的表单。
然后,代码中还使用了一个CommonDialog控件让我们选择保存图片的文件路径。虽然可以通过 Windows + Access 的某些组合使用,但我们不能依赖它,因此我们将改用 FileDialog。
要获取文件路径,我们将以下代码添加到我们的表单模块中:
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
然后,我们 copy-paste 初始声明(类型和声明函数语句),并进行 2 次调整:
因为我们要将它们放在表单模块中,所以需要删除默认情况下私有的所有内容的 Public
,并将这些内容更改为 Private
那不是。
由于我们要兼容64位Access(你说你不需要,但还是添加了),我们想添加PtrSafe
关键字所有外部函数,并将所有指针的类型从 Long
更改为 LongPtr
。此代码位于我们刚刚创建的函数之前。
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
现在,我们可以复制粘贴实际函数,并进行 2 处更改:
- 我们使用
GetSavePath
函数来获取用户想要保存文件的路径,而不是常见的对话框控制代码。
- 我们使用
PicWebCam.Form.hWnd
而不是 PicWebCam.hWnd
来获取我们要用网络摄像头源填充的帧的 hWnd。
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
最后,由于我们为 Form_Load
事件添加了事件处理程序,因此我们需要确保表单的 On Load
属性 设置为 [Event Procedure]
。我们添加的所有命令按钮的 On Click
属性 也是如此。
就是这样,我们已经成功地将网络摄像头代码从 VB6 迁移到 VBA,并重新创建了您提供的 link 中稀疏描述的表单。大部分代码都归功于作者 link。
您可以暂时下载结果here。请注意,我建议您不要这样做,既出于教育目的,也因为您不应该相信互联网上随机的陌生人会为您提供未签名的可执行文件。但如果遇到错误,它很有用,因此您可以检查它是否可能是网络摄像头兼容性问题或错误。
请注意,我没有对原始代码进行任何实际的功能更改。
我正在 Microsoft Access 2013 中设计一个数据库来存储工厂中发现的故障部件的记录。
我正在尝试在我的表单上实现一个按钮,用户可以单击该按钮来访问他们设备的摄像头,以在表单中附加故障图片。用户在戴尔 Latitude 5290 二合一设备上使用 Windows 10。
我尝试了在网上找到的代码,但它非常旧。 https://www.developerfusion.com/thread/46191/how-to-capture-picture-using-webcam-in-vb60/
我发现您在自己调整代码时遇到了问题,所以让我向您介绍一下 VBA 的调整过程。
首先,我们将创建一个包含网络摄像头代码的表单,并向其中添加所需的控件。控件是:
4 个按钮,分别称为 cmd1、cmd2、cmd3 和 cmd4,以及 1 个子窗体控件,称为 PicWebCam。我们正在使用子窗体替换 PictureBox 对象,因为它在 Access 中不可用。
由于子窗体需要显示一些东西,我们在设计视图中创建第二个窗体,并将记录选择器和导航按钮设置为否。我们不向窗体添加任何控件,并将其设置得足够小,因此它不会有滚动条。然后,我们将子表单控件的源对象设置为我们刚刚创建的表单。
然后,代码中还使用了一个CommonDialog控件让我们选择保存图片的文件路径。虽然可以通过 Windows + Access 的某些组合使用,但我们不能依赖它,因此我们将改用 FileDialog。
要获取文件路径,我们将以下代码添加到我们的表单模块中:
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
然后,我们 copy-paste 初始声明(类型和声明函数语句),并进行 2 次调整:
因为我们要将它们放在表单模块中,所以需要删除默认情况下私有的所有内容的
Public
,并将这些内容更改为Private
那不是。由于我们要兼容64位Access(你说你不需要,但还是添加了),我们想添加
PtrSafe
关键字所有外部函数,并将所有指针的类型从Long
更改为LongPtr
。此代码位于我们刚刚创建的函数之前。
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
现在,我们可以复制粘贴实际函数,并进行 2 处更改:
- 我们使用
GetSavePath
函数来获取用户想要保存文件的路径,而不是常见的对话框控制代码。 - 我们使用
PicWebCam.Form.hWnd
而不是PicWebCam.hWnd
来获取我们要用网络摄像头源填充的帧的 hWnd。
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
最后,由于我们为 Form_Load
事件添加了事件处理程序,因此我们需要确保表单的 On Load
属性 设置为 [Event Procedure]
。我们添加的所有命令按钮的 On Click
属性 也是如此。
就是这样,我们已经成功地将网络摄像头代码从 VB6 迁移到 VBA,并重新创建了您提供的 link 中稀疏描述的表单。大部分代码都归功于作者 link。
您可以暂时下载结果here。请注意,我建议您不要这样做,既出于教育目的,也因为您不应该相信互联网上随机的陌生人会为您提供未签名的可执行文件。但如果遇到错误,它很有用,因此您可以检查它是否可能是网络摄像头兼容性问题或错误。
请注意,我没有对原始代码进行任何实际的功能更改。