Question

所以，我正在构建一个需要访问计算机上的单个网络摄像头的应用程序，问题是每当我运行应用程序时，我都会从Windows获取一个对话框，要求选择一个视频源。我想以编程方式选择标准设备。有没有人知道我该怎么做？

主要应用代码：

Imports WindowsApplication1.iCam
Imports System.Drawing.Imaging

    Public Class Form1
        Dim myCam As iCam
        Dim Dir As String
        Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
            myCam = New iCam
            myCam.setFrameRate(20)
            myCam.initCam(PictureBox1.Handle.ToInt32)

        End Sub

        Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
            Dim image As Bitmap
            image = myCam.copyFrame(PictureBox1, New RectangleF(0, 0, PictureBox1.Width, PictureBox1.Height))
            Dim g As Graphics
            g = Graphics.FromImage(image)
            image.Save(Dir, ImageFormat.Jpeg)
        End Sub
    End Class

iCam课程：

Option Explicit On 
Option Strict On

Public Class iCam
#Region "Api/constants"

    Private Const WS_CHILD As Integer = &H40000000
    Private Const WS_VISIBLE As Integer = &H10000000
    Private Const SWP_NOMOVE As Short = &H2S
    Private Const SWP_NOZORDER As Short = &H4S
    Private Const WM_USER As Short = &H400S
    Private Const WM_CAP_DRIVER_CONNECT As Integer = WM_USER + 10
    Private Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_USER + 11
    Private Const WM_CAP_SET_VIDEOFORMAT As Integer = WM_USER + 45
    Private Const WM_CAP_SET_PREVIEW As Integer = WM_USER + 50
    Private Const WM_CAP_SET_PREVIEWRATE As Integer = WM_USER + 52
    Private Const WM_CAP_GET_FRAME As Long = 1084
    Private Const WM_CAP_COPY As Long = 1054
    Private Const WM_CAP_START As Long = WM_USER
    Private Const WM_CAP_STOP As Long = (WM_CAP_START + 68)
    Private Const WM_CAP_SEQUENCE As Long = (WM_CAP_START + 62)
    Private Const WM_CAP_SET_SEQUENCE_SETUP As Long = (WM_CAP_START + 64)
    Private Const WM_CAP_FILE_SET_CAPTURE_FILEA As Long = (WM_CAP_START + 20)

    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Short, ByVal lParam As String) As Integer
    Private Declare Function capCreateCaptureWindowA Lib "avicap32.dll" (ByVal lpszWindowName As String, ByVal dwStyle As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Short, ByVal hWndParent As Integer, ByVal nID As Integer) As Integer
    Private Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Short, ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, ByVal cbVer As Integer) As Boolean
    Private Declare Function BitBlt Lib "GDI32.DLL" (ByVal hdcDest As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As Int32) As Boolean

#End Region

    Private iDevice As String
    Private hHwnd As Integer
    Private lwndC As Integer

    Public iRunning As Boolean

    Private CamFrameRate As Integer = 15
    Private OutputHeight As Integer = 240
    Private OutputWidth As Integer = 360

    Public Sub resetCam()
        'resets the camera after setting change
        If iRunning Then
            closeCam()
            Application.DoEvents()

            If setCam() = False Then
                MessageBox.Show("Errror Setting/Re-Setting Camera")
            End If
        End If

    End Sub

    Public Sub initCam(ByVal parentH As Integer)
        'Gets the handle and initiates camera setup
        If Me.iRunning = True Then
            MessageBox.Show("Camera Is Already Running")
            Exit Sub
        Else

            hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, OutputWidth, CShort(OutputHeight), parentH, 0)


            If setCam() = False Then
                MessageBox.Show("Error setting Up Camera")
            End If
        End If
    End Sub

    Public Sub setFrameRate(ByVal iRate As Long)
        'sets the frame rate of the camera
        CamFrameRate = CInt(1000 / iRate)

        resetCam()

    End Sub

    Private Function setCam() As Boolean
        'Sets all the camera up
        If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, CShort(iDevice), CType(0, String)) = 1 Then
            SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, CShort(CamFrameRate), CType(0, String))
            SendMessage(hHwnd, WM_CAP_SET_PREVIEW, 1, CType(0, String))
            Me.iRunning = True
            Return True
        Else
            Me.iRunning = False
            Return False
        End If
    End Function

    Public Function closeCam() As Boolean
        'Closes the camera
        If Me.iRunning Then
            closeCam = CBool(SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, 0, CType(0, String)))
            Me.iRunning = False
        End If
    End Function

    Public Function copyFrame(ByVal src As PictureBox, ByVal rect As RectangleF) As Bitmap
        If iRunning Then
            Dim srcPic As Graphics = src.CreateGraphics
            Dim srcBmp As New Bitmap(src.Width, src.Height, srcPic)
            Dim srcMem As Graphics = Graphics.FromImage(srcBmp)


            Dim HDC1 As IntPtr = srcPic.GetHdc
            Dim HDC2 As IntPtr = srcMem.GetHdc

            BitBlt(HDC2, 0, 0, CInt(rect.Width), _
              CInt(rect.Height), HDC1, CInt(rect.X), CInt(rect.Y), 13369376)

            copyFrame = CType(srcBmp.Clone(), Bitmap)

            'Clean Up 
            srcPic.ReleaseHdc(HDC1)
            srcMem.ReleaseHdc(HDC2)
            srcPic.Dispose()
            srcMem.Dispose()
        Else
            MessageBox.Show("Camera Is Not Running!")
        End If
    End Function

    Public Function FPS() As Integer
        Return CInt(1000 / (CamFrameRate))
    End Function

End Class

Answer 1

出现视频源对话框，因为您在Windows上安装了另一个视频输入设备。搜索Regedit.exe中VideoSourcedialog上列出的设备并删除该条目（如果您不使用它们）。

我使用DroidCam来测试网络摄像头功能，每当我打电话给WM_CAP_DRIVER_CONNECT时，对话框就会出现：

-DroidCam 1
-Droidcam 2
-Droidcam 3 (*)
-MiniDroidCam 240p

当删除DroidCam1，DroidCam2和MiniDroidCam 240p的Windows注册表（对于以前安装的Droidcam）时，只需单击“捕获”按钮即可使网络摄像头运行而无需任何对话框。

抱歉我的英语。

Answer 2

最后，我找到了解决方案。问题发生在Windows 7/8

首先你需要这个API函数

Private Declare Function GetTickCount Lib "kernel32" () As Long

然后......在你致电capCreateCaptureWindowA()之后你必须等待1秒钟处理事件，（注意：睡眠不起作用）

IniTime = GetTickCount()
While GetTickCount() < (IniTime + 1000)
DoEvents
Wend

然后你拨打WM_CAP_DRIVER_CONNECT.. and THAT's IT

VB.NET和WebCam选择“视频源”对话框

2 个答案: