大橙子网站建设,新征程启航
为企业提供网站建设、域名注册、服务器等服务
VB截取摄像头图像我可以给你三种方法:
创新互联主要从事网站制作、成都做网站、网页设计、企业做网站、公司建网站等业务。立足成都服务兴文,10年网站建设经验,价格优惠、服务专业,欢迎来电咨询建站服务:028-86922220
方案一:
简单点到下面这个网站下载照相控件即可满足你的需要。
takephoto.ocx照相控件
方案二:
另外,还可以下载摄像头图像显示控件。vbgood.com上有一个摄像头显示用的ocx控件,下载下来把它放入你的Form里。
然后用WinAPI函数Bitblt 把摄像头控件的HDC图像,复制导Picture1.hDC即可显示出来。这个方法代码多些,但还算简单。
方案三:
最复杂的是纯粹调用WinAPI函数实现的摄像头捕捉,好处是不依赖任何控件,对系统兼容性很好。但代码复杂度较高看你的VB掌握水平了。
主要是使用以下两个API函数。
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
Declare Function capGetDriverDescriptionA Lib "avicap32.dll" ( _
ByVal wDriver As Integer, _
ByVal lpszName As String, _
ByVal cbName As Long, _
ByVal lpszVer As String, _
ByVal cbVer As Long) As Boolean
这是6.0的,.net的做些改动就成!因为我没装摄像头,就没改! 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
VB.NT用的是触发事件,一按就会触发,要不你加个timer控件,延迟一秒
标题的问题:你先把图片保存,再加载