我发现您自己调整代码时遇到了困难,所以让我引导您完成针对 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
然后,我们复制粘贴初始声明(类型和声明函数语句),并进行 2 项调整:
由于我们要将它们放置在表单模块中,Public
需要删除默认情况下私有的所有内容,并将其更改为Private
对于那些不是的东西。
由于我们想要兼容 64 位 Access(你说你不需要,但无论如何都添加它),我们想要添加PtrSafe
关键字到所有外部函数,并更改所有指针的类型Long
to 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.hWnd
, 我们用PicWebCam.Form.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,并重新创建了您提供的链接中稀疏描述的表单。大部分代码的版权归该链接的作者所有。
您可以暂时下载结果here。请注意,我建议您不要这样做,既是出于教育目的,也是因为您不应该相信互联网上随机的陌生人为您提供未签名的可执行文件。但如果您遇到错误,它会很有用,因此您可以检查它是否可能是网络摄像头兼容性问题或错误。
请注意,我没有对原始代码进行任何真正的功能更改。