从网络摄像头捕获视频并在图片框中显示

该程序检查网络摄像头是否可用，如果可用，则捕获视频并显示在图片框中。

将此代码添加到常规模块（.BAS文件）

-------------------------------------------------- --------------------

Public Const ws_child As Long = &H40000000
Public Const ws_visible As Long = &H10000000 
Global Const WM_USER = 1024
Global Const wm_cap_driver_connect = WM_USER + 10
Global Const wm_cap_set_preview = WM_USER + 50
Global Const WM_CAP_SET_PREVIEWRATE = WM_USER + 52
Global Const WM_CAP_DRIVER_DISCONNECT As Long = WM_USER + 11
Public Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_USER + 41
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal a As String, ByVal b As Long, ByVal c As Integer, ByVal d As Integer, ByVal e As Integer, ByVal f As Integer, ByVal g As Long, ByVal h As Integer) As Long

在表单中添加4个命令按钮和一个图片框

添加以下代码以单击相应按钮的en \ vent。

'General Declaration
Dim hwdc As Long
Dim startcap As Boolean 
Private Sub cmdCapture_Click()
Dim temp As Long 
  hwdc = capCreateCaptureWindow("Debasis Das", ws_child Or ws_visible, 0, 0, 320, 240, Picture1.hWnd, 0)
  If (hwdc <> 0) Then
    temp = SendMessage(hwdc, wm_cap_driver_connect, 0, 0)
    temp = SendMessage(hwdc, wm_cap_set_preview, 1, 0)
    temp = SendMessage(hwdc, WM_CAP_SET_PREVIEWRATE, 30, 0)
    startcap = True
    Else
    MsgBox ("No Webcam found")
  End If
End Sub 
Private Sub cmdClose_Click()
Dim temp As Long
If startcap = True Then
temp = SendMessage(hwdc, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
startcap = False
End If
End Sub 
Private Sub cmdexit_Click()
Unload Me
End Sub 
Private Sub cmdVideoFormat_Click()
 Dim temp As Long
 If startcap = True Then
  temp = SendMessage(hwdc, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
End If
End Sub 

为了实现这一点，使用了两个API函数。

1。

capCreateCaptureWindow

2。

发信息

请查找功能的详细信息以获取更多信息。

From: https://bytes.com/topic/visual-basic/insights/720399-capture-video-webcam-displays-picture-box