专注收集记录技术开发学习笔记、技术难点、解决方案
网站信息搜索 >> 请输入关键词:
您当前的位置: 首页 > VB Dotnet

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

发布时间:2011-06-23 15:59:26 文章来源:www.iduyao.cn 采编人员:星星草
在程序中和摄像头的连接问题?有人知道吗?
我的电脑上装了一个良田的摄像头.我现在想自己做一个程序,在我的程序中抓图,不知道该怎么去做,有人知道吗?谢谢

------解决方案--------------------
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.InteropServices

Public 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 Sub

End Class
友情提示:
信息收集于互联网,如果您发现错误或造成侵权,请及时通知本站更正或删除,具体联系方式见页面底部联系我们,谢谢。

其他相似内容:

热门推荐: