WIN 10 怎么获取摄像头

[jainkai]

WIN 10 下获取摄像头

有在WIN10下调用过摄像头的么。。
传统打开摄像头的方法都没用，一片黑
在相机-隐私里，没有这个程序使用的权限开关，

请问谁打开过WIN10的摄像头啊

[脆皮大雪糕]

普通模块代码：

Option Explicit

Private Declare 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 Long, _
                                                ByVal nID As Long) As Long

Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WM_USER = &H400
Private Const WM_CAP_START = &H400
Private Const WM_CAP_EDIT_COPY = (WM_CAP_START + 30)
Private Const WM_CAP_DRIVER_CONNECT = (WM_CAP_START + 10)
Private Const WM_CAP_SET_PREVIEWRATE = (WM_CAP_START + 52)
Private Const WM_CAP_SET_OVERLAY = (WM_CAP_START + 51)
Private Const WM_CAP_SET_PREVIEW = (WM_CAP_START + 50)
Private Const WM_CAP_DRIVER_DISCONNECT = (WM_CAP_START + 11)

Private Declare Function SendMessage Lib "user32" _
                                     Alias "SendMessageA" ( _
                                     ByVal hwnd As Long, _
                                     ByVal wMsg As Long, _
                                     ByVal wParam As Long, _
                                     lParam As Any) As Long

Private Preview_Handle As Long


Public Function CreateCaptureWindow( _
       hWndParent As Long, _
       Optional x As Long = 0, _
       Optional y As Long = 0, _
       Optional nWidth As Long = 800, _
       Optional nHeight As Long = 600, _
       Optional nCameraID As Long = 0) As Long

    On Error GoTo errhandle
    Preview_Handle = capCreateCaptureWindow("Video", _
                                            WS_CHILD + WS_VISIBLE, x, y, _
                                            nWidth, nHeight, hWndParent, 1)

    SendMessage Preview_Handle, WM_CAP_DRIVER_CONNECT, nCameraID, 0
    SendMessage Preview_Handle, WM_CAP_SET_PREVIEWRATE, 30, 0
    SendMessage Preview_Handle, WM_CAP_SET_OVERLAY, 1, 0
    SendMessage Preview_Handle, WM_CAP_SET_PREVIEW, 1, 0

    CreateCaptureWindow = Preview_Handle
    Exit Function
errhandle:
    MsgBox Err.Description
End Function


Public Function CapturePicture(nCaptureHandle As Long) As StdPicture
    Clipboard.Clear

    SendMessage nCaptureHandle, WM_CAP_EDIT_COPY, 0, 0
    Set CapturePicture = Clipboard.GetData
End Function


Public Sub Disconnect(nCaptureHandle As Long, _
                      Optional nCameraID = 0)

    SendMessage nCaptureHandle, WM_CAP_DRIVER_DISCONNECT, _
                nCameraID, 0
End Sub

[脆皮大雪糕]

新建窗体，放一个picturebox, 一个timer 两个按钮。 窗体代码如下：

Option Explicit

Dim Video_Handle As Long
'连接摄像头
Public Sub LinkCam()
    On Error Resume Next
    Video_Handle = CreateCaptureWindow(Picture1.hwnd, 0, 0, Picture1.Width, Picture1.Height)
    DoEvents
    Timer1.Interval = 25
    Timer1.Enabled = True
End Sub
'断开摄像头
Public Sub DiscontCam()
    On Error Resume Next
    Timer1.Enabled = False
    Picture1.Cls
    Timer1.Enabled = False
    Disconnect Video_Handle
End Sub

Private Sub Command1_Click()
    LinkCam
End Sub

Private Sub Command2_Click()
    DiscontCam
End Sub

Private Sub Form_Load()
    Me.ScaleMode = 3
    Picture1.ScaleMode = 3
End Sub

Private Sub Timer1_Timer()
    On Error Resume Next
    Dim sp As New StdPicture
    Picture1.Cls
    Set sp = CapturePicture(Video_Handle)
    Picture1.PaintPicture sp, 0, 0
End Sub

[脆皮大雪糕]

效率不是很高的方法，但简单，并且在Win10下有效。

[jainkai]

打不开 还是一片黑 但是也不报错，程序也没假死 就是一片黑

我是WIN10的平板 小米2

[脆皮大雪糕]

拿到代码，不行，跟踪一下。说个现象你再花半天一天的等回复不觉得亏么。 为啥不报错，因为里面一堆的 On Error Resume Next 把 On Error Resume Next 全部注释掉。 单步跟踪，看看 Video_Handle 取到值没有