首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > .NET > VB Dotnet >

在程序中和摄像头的连接有关问题?有人知道吗

2012-02-07 
在程序中和摄像头的连接问题?有人知道吗?我的电脑上装了一个良田的摄像头.我现在想自己做一个程序,在我的

在程序中和摄像头的连接问题?有人知道吗?
我的电脑上装了一个良田的摄像头.我现在想自己做一个程序,在我的程序中抓图,不知道该怎么去做,有人知道吗?谢谢

[解决办法]
Camera Vision - video surveillance on C#
http://www.codeproject.com/cs/media/cameraviewer.asp

Motion detection using web cam
http://www.codeproject.com/cs/media/motion_detection_wc.asp
[解决办法]

VB.NET code
Imports System.Runtime.InteropServicesPublic Class WebCam    Const WM_CAP As Short = &H400S    Const WM_CAP_STOP As Integer = WM_CAP + 68    Const WM_CAP_SEQUENCE As Integer = WM_CAP + 62    Const WM_CAP_DRIVER_CONNECT As Integer = WM_CAP + 10    Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_CAP + 11    Const WM_CAP_FILE_SET_CAPTURE_FILEA As Integer = WM_CAP + 20    Const WM_CAP_EDIT_COPY As Integer = WM_CAP + 30    Const WM_CAP_FILE_SAVEAS As Integer = WM_CAP + 23    Const WM_CAP_SET_PREVIEW As Integer = WM_CAP + 50    Const WM_CAP_SET_PREVIEWRATE As Integer = WM_CAP + 52    Const WM_CAP_SET_SCALE As Integer = WM_CAP + 53    Const WS_CHILD As Integer = &H40000000    Const WS_VISIBLE As Integer = &H10000000    Const SWP_NOMOVE As Short = &H2S    Const SWP_NOSIZE As Short = 1    Const SWP_NOZORDER As Short = &H4S    Const HWND_BOTTOM As Short = 1    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _        (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, _        <MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Boolean    Private 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    Private Declare Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean    Private 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 Integer, ByVal hWndParent As Integer, _        ByVal nID As Integer) As Integer    Private Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Integer, _        ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, _        ByVal cbVer As Integer) As Boolean    Private iDevice As Integer = -1             '当前设备ID    Private mWebCamName As String               '当前设备名称    Private hHwnd As Integer = -1               '预览窗口句柄    Public Sub New()        Dim strDeviceName() As String        strDeviceName = GetDeviceNameList()        If strDeviceName.Length > 0 Then            iDevice = 0            mWebCamName = strDeviceName(0)        Else            Throw New ApplicationException("没有发现任何可用的WebCam设备!!!")        End If    End Sub    Public Property WebCamName() As String        Get            Return mWebCamName        End Get        Set(ByVal Value As String)            Dim i As Integer            Dim strDeviceName() As String = GetDeviceNameList()            For i = 0 To strDeviceName.Length - 1                If strDeviceName(i) = Value Then                    iDevice = i                    mWebCamName = strDeviceName(i)                    Exit For                End If            Next            If mWebCamName <> Value Then                Throw New ApplicationException("WebCam设备<" & Value & ">不存在!!!")            End If        End Set    End Property    Public Function GetDeviceNameList() As String()        Dim intDriverIndex As Integer = 0        Dim strName As String = Space(100)        Dim strVer As String = Space(100)        Dim strReturn(-1) As String        Dim blnResult As Boolean        Do            blnResult = capGetDriverDescriptionA(intDriverIndex, strName, 100, strVer, 100)            If blnResult Then                ReDim Preserve strReturn(intDriverIndex)                strReturn(intDriverIndex) = strName.Trim            End If            intDriverIndex += 1        Loop Until blnResult = False        Return strReturn    End Function    Public Sub StartPreview(ByVal HandleToPreview As Integer, ByVal intPreviewWidth As Integer, ByVal intPreviewHeight As Integer)        hHwnd = capCreateCaptureWindowA(Me.WebCamName, WS_VISIBLE Or WS_CHILD, 0, 0, intPreviewWidth, intPreviewHeight, HandleToPreview, 0)        If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0) Then            SendMessage(hHwnd, WM_CAP_SET_SCALE, CType(True, Integer), 0)            SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0)            SendMessage(hHwnd, WM_CAP_SET_PREVIEW, CType(True, Integer), 0)            SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, intPreviewWidth, intPreviewHeight, SWP_NOMOVE Or SWP_NOZORDER)        Else            DestroyWindow(hHwnd)        End If    End Sub    Public Sub StopPreview()        If hHwnd >= 0 Then            SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, iDevice, 0)            DestroyWindow(hHwnd)            iDevice = -1            hHwnd = -1        End If    End Sub    Public Function CapturePicture(Optional ByVal blnCopyToClipboard As Boolean = True) As Image        Dim iData As IDataObject        Dim bImage As Image        SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)        iData = Clipboard.GetDataObject()        If iData.GetDataPresent(GetType(System.Drawing.Bitmap)) Then            bImage = CType(iData.GetData(GetType(System.Drawing.Bitmap)), Image)        End If        If blnCopyToClipboard = False Then            Clipboard.SetDataObject(String.Empty)        End If        Return bImage    End Function    Public Sub StartKinescope(ByVal strSavePath As String)        If hHwnd >= 0 Then            SendMessage(hHwnd, WM_CAP_FILE_SET_CAPTURE_FILEA, 0, strSavePath)            SendMessage(hHwnd, WM_CAP_SEQUENCE, 0, 0)        Else            Throw New ApplicationException("WebCam设备还没有连接,请先调用StartPreview()方法连接设备!!!")        End If    End Sub    Public Sub StopKinescope()        SendMessage(hHwnd, WM_CAP_STOP, 0, 0)    End Sub    Protected Overrides Sub Finalize()        MyBase.Finalize()        If hHwnd >= 0 Then            SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, iDevice, 0)            DestroyWindow(hHwnd)        End If    End SubEnd Class 

热点排行