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
上述禅喊春代码就可以实现 但是要注意相应的控件是否存在 不存在的 你自己画出来
给你个工程自己看...
运行后可以高老看到自己悄蚂...
点按钮保存到启念埋c:\1.bmp
这是6.0的，点虐 的做些改动就成！因为我没装摄像头，就没改！ 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 = 320, _ Optional nHeight As Long = 240, _ Optional nCameraID As Long = 0) As Long 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 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 4在form上添加一个PictureBox,一个按钮,Caption设为 Save Pic Dim Video_Handle As Long Private Sub Form_Load() Video_Handle = CreateCaptureWindow(PicCapture.hwnd) End Sub Private Sub Command1_Click() Dim x As StdPicture Set x = CapturePicture(Video_Handle) SavePicture x, "c:\a.bmp" End Sub Private Sub Form_Unload(Cancel As Integer) Disconnect Video_Handle End Sub 追问： 可不可以帮忙写为VB.NET的程序..?我自己运行后显示 未声明 PicCapture 追问： nCameraID = 0 这里在VB.NET下也用不了Clipboard.GetData 在VB.NET里也要跟参数的..我自己试用VB可以的..希望你能帮忙写一个VB.NET的..因为就算没有摄像头picturebox也会显示黑色的 回答： 你这程序是工程用的！请加多点分！我给你改 追问： 可不可以加我QQ先344568960 因为我积分不多...或许我可以给Q币你怎么的~可以吗？ 追问： 已经补充了积分了~希望能帮忙改成VB.NET的吧~谢谢~ 回答： 建一个picturebox 和 button Imports System.Runtime.InteropServices Public Class Form1 Const WM_CAP_START = H400S Const WS_CHILD = H40000000 Const WS_VISIBLE = H10000000 Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10 Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11 Const WM_CAP_EDIT_COPY = WM_CAP_START + 30 Const WM_CAP_SEQUENCE = WM_CAP_START + 62 Const WM_CAP_FILE_SAVEAS = WM_CAP_START + 23 Const WM_CAP_SET_SCALE = WM_CAP_START + 53 Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52 Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50 Const SWP_NOMOVE = H2S Const SWP_NOSIZE = 1 Const SWP_NOZORDER = H4S Const HWND_BOTTOM = 1 Dim hWnd As Integer Declare Function capGetDriverDescriptionA Lib "avicap32.dll" _ (ByVal wDriverIndex As Short, _ ByVal lpszName As String, ByVal cbName As Integer, _ ByVal lpszVer As String, _ ByVal cbVer As Integer) As Boolean 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 hWnd As Integer, _ ByVal nID As Integer) As Integer Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Integer, ByVal Msg As Integer, _ ByVal wParam As Integer, _ Runtime.InteropServices.MarshalAs(UnmanagedType.AsAny) ByVal lParam As Object) _ As Integer Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" _ (ByVal hwnd As Integer, _ ByVal hWndInsertAfter As Integer, ByVal x As Integer, _ ByVal y As Integer, _ ByVal cx As Integer, ByVal cy As Integer, _ ByVal wFlags As Integer) As Integer Declare Function DestroyWindow Lib "user32" _ (ByVal hndw As Integer) As Boolean Private Sub PreviewVideo(ByVal pbCtrl As PictureBox) hWnd = capCreateCaptureWindowA(0, _ WS_VISIBLE Or WS_CHILD, 0, 0, 0, _ 0, pbCtrl.Handle.ToInt32, 0) If SendMessage( _ hWnd, WM_CAP_DRIVER_CONNECT, _ 0, 0) Then SendMessage(hWnd, WM_CAP_SET_SCALE, True, 0) SendMessage(hWnd, WM_CAP_SET_PREVIEWRATE, 30, 0) SendMessage(hWnd, WM_CAP_SET_PREVIEW, True, 0) SetWindowPos(hWnd, HWND_BOTTOM, 0, 0, _ pbCtrl.Width, pbCtrl.Height, _ SWP_NOMOVE Or SWP_NOZORDER) Else DestroyWindow(hWnd) End If End Sub Private Sub Form1_Load( _ ByVal sender As System.Object, _ ByVal e As System.EventArgs) Handles MyBase.Load PreviewVideo(PictureBox1) End Sub Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim data As IDataObject Dim bmap As Image SendMessage(hWnd, WM_CAP_EDIT_COPY, 0, 0) data = Clipboard.GetDataObject() If data Is Nothing Then Exit Sub If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then bmap = CType(data.GetData(GetType( _ System.Drawing.Bitmap)), Image) bmap.Save("d:\a.bmp", System.Drawing.Imaging.ImageFormat.Bmp) MsgBox("完成") End If End Sub End Class
这个方法没银冲问题。
win8.1，我用网上的锋蠢歼方法，有时档睁也有黑屏现象，但多试几次就好了。有时还会弹出要选择摄像头，选择确认、取消、应用都是黑屏。
重庆分公司
重庆分公司
