重庆分公司,新征程启航
为企业提供网站建设、域名注册、服务器等服务
下面是我之前在VB6里测试过的代码:在窗体里放一个按钮叫Command1和一个PictureBox叫Picture1。 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 Declare Function SendMessageAsLong Lib "user32" Alias "SendMessageA" _ (ByVal hWnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Private Preview_Handle As Long Private iDevice As Long Private hHwnd As Long Private Sub Command1_Click() Dim bRet As Boolean Dim szTest As String szTest = App.Path "\TEST.bmp" Chr$(0) bRet = capEditCopy(hHwnd) If bRet Then DoEvents If Clipboard.GetFormat(vbCFBitmap) Then Picture1.Picture = Clipboard.GetData(vbCFBitmap) Picture1.Picture = Clipboard.GetData(vbCFBitmap) SavePicture Picture1.Image, szTest DoEvents Clipboard.Clear End If End If End Sub Private Sub Form_Load() '建立捕获窗口 Preview_Handle = capCreateCaptureWindow("Video", WS_CHILD + WS_VISIBLE, 0, 0, 320, 240, Me.hWnd, 1) '建立捕获窗口到捕获设备的连接 SendMessage Preview_Handle, WM_CAP_DRIVER_CONNECT, 0, 0 '设置捕获的帧频率为30毫秒一帧 SendMessage Preview_Handle, WM_CAP_SET_PREVIEWRATE, 30, 0 '用预览模式在捕获窗口开始预览图像 SendMessage Preview_Handle, WM_CAP_SET_PREVIEW, 1, 0 End Sub Private Sub Form_Unload(Cancel As Integer) '断开到捕获设备的连接 SendMessage Preview_Handle, WM_CAP_DRIVER_DISCONNECT, 0, 0 End Sub Private Function capEditCopy(ByVal hCapWnd As Long) As Boolean capEditCopy = SendMessageAsLong(hCapWnd, WM_CAP_EDIT_COPY, 0, 0) End Function
创新互联于2013年创立,是专业互联网技术服务公司,拥有项目网站设计、成都网站设计网站策划,项目实施与项目整合能力。我们以让每一个梦想脱颖而出为使命,1280元西平做网站,已为上家服务,为西平各地企业和个人服务,联系电话:18980820575
给你个工程自己看...
运行后可以看到自己...
点按钮保存到c:\1.bmp
1.点击打开开始菜单 - 电脑设置,打开电脑设置窗口。如下图所示
2.在打开的电脑设置窗口中,点击打开“隐私”项进入下一步操作。如下图所示
3.在隐私功能界面中,找到“摄像头”点击打开。如下图所示
4.点击将允许应用使用我的摄像头开启,关闭电脑设置窗口完成操作。如下图所示
Private Const WS_CHILD = H40000000
Private Const WS_VISIBLE = H10000000
Private Const WM_CAP_START = H400
Private Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
Private Const WM_CAP_SET_SCALE = WM_CAP_START + 53
Private Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
Private Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50
Private Declare Function capCreateCaptureWindowA Lib "avicap32.dll" ( _
ByVal lpszWindowName As String, _
ByVal dwStyle As Long, _
ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Integer, _
ByVal hWndParent As Long, ByVal nID As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Sub Form_Load()
'建立采集窗口(不显示窗口,处理后显示到PIC控件)
uwndc = capCreateCaptureWindowA("", WS_VISIBLE Or WS_CHILD, 0, 0, 320, 240, Me.hWnd, 0)
'连接
SendMessage uwndc, WM_CAP_DRIVER_CONNECT, 0, 0
'Scale开
SendMessage uwndc, WM_CAP_SET_SCALE, True, 0
'显示刷新MS
SendMessage uwndc, WM_CAP_SET_PREVIEWRATE, 40, 0
'用予览方式显示(特殊需要,不显示予缆)
SendMessage uwndc, WM_CAP_SET_PREVIEW, True, 0
End Sub
上述代码就可以实现 但是要注意相应的控件是否存在 不存在的 你自己画出来
这个方法没问题。
win8.1,我用网上的方法,有时也有黑屏现象,但多试几次就好了。有时还会弹出要选择摄像头,选择确认、取消、应用都是黑屏。