Question

vb 制作摄像头视频拍照程序

我在网上找到如下方式在xp系统下运行正常。但是在win7下去没有显示图像只是一块黑屏 请高手指点急~~！！！！
Public 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
Public Const WS_CHILD = &H40000000
Public Const WS_VISIBLE = &H10000000
Public Const WM_USER = &H400
Public Const WM_CAP_START = &H400
Public Const WM_CAP_EDIT_COPY = (WM_CAP_START + 30)
Public Const WM_CAP_DRIVER_CONNECT = (WM_CAP_START + 10)
Public Const WM_CAP_SET_PREVIEWRATE = (WM_CAP_START + 52)
Public Const WM_CAP_SET_OVERLAY = (WM_CAP_START + 51)
Public Const WM_CAP_SET_PREVIEW = (WM_CAP_START + 50)
Public Const WM_CAP_DRIVER_DISCONNECT = (WM_CAP_START + 11)
Public Preview_Handle As Long
Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Public Function CapturePicture(nCaptureHandle As Long) As StdPicture
Clipboard.Clear
SendMessage nCaptureHandle, WM_CAP_EDIT_COPY, 0, 0
Set CapturePicture = Clipboard.GetData
End Function
‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’
Private Sub Command1_Click()
Picture1.Picture = CapturePicture(Preview_Handle)
End Sub
Private Sub Command2_Click()
SavePicture Picture1.Picture, "c:\a.bmp"
End Sub
Private Sub Form_Load()
Preview_Handle = capCreateCaptureWindow("Video", WS_CHILD + WS_VISIBLE, 24, 20, 400, 350, Me.hwnd, 0)
SendMessage Preview_Handle, WM_CAP_DRIVER_CONNECT, 0, 0
SendMessage Preview_Handle, WM_CAP_SET_PREVIEWRATE, 1, 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

Answer 1

以面代码是我以前用的,win7应该也支持你试试

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 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 GET_FRAME As Long = 1084
Private Const COPY As Long = 1054
Private Const CONNECT As Long = 1034
Private Const DISCONNECT As Long = 1035
Private CapHwnd As Long
Private Sub Command1_Click() '截图按钮
On Error Resume Next
SendMessage CapHwnd, GET_FRAME, 0, 0
SendMessage CapHwnd, COPY, 0, 0
Image2.Picture = Clipboard.GetData
Clipboard.Clear
End Sub
Private Sub Form_Load()
'打开摄像头
CapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 320, 240, Me.hwnd, 0)
DoEvents
SendMessage CapHwnd, CONNECT, 0, 0
Timer1.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
'停止摄像头
DoEvents: SendMessage CapHwnd, DISCONNECT, 0, 0
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer() 'timer1.Interval=50
On Error Resume Next
SendMessage CapHwnd, GET_FRAME, 0, 0
SendMessage CapHwnd, COPY, 0, 0
Image1.Picture = Clipboard.GetData
Clipboard.Clear
End Sub
'
'Private Sub Timer2_Timer()
'Static z
'z = z + 1
'SavePicture Image1.Picture, "c:\1\" & z & ".BMP" ' 将图片保存到文件。
'
'End Sub

追问

xp里连黑框都没有。win7也一样。

追答

这个是保存成图片了 你可以读这个图片

Answer 2

安装摄像头万能驱动后再试试