VB.NET和摄像头选择视频源对话框对话框、摄像头、视频、VB

2023-09-03 06:14:06 作者:壞壞侽孩冇嚸帥

所以,我建这需要能够访问计算机上的一个摄像头的应用程序,问题是,每当我运行的应用程序,我从Windows获得一个对话框,要求选择一个视频源。我想使它编程选择的标准设备。没有任何人对我应该如何处理这个任何想法?

主要应用code:

 进口WindowsApplication1.iCam
进口System.Drawing.Imaging

    公共类Form1中
        昏暗myCam作为ICAM
        昏暗目录作为字符串
        私人小组Form1_Load的(发送者为对象,E作为EventArgs的)把手MyBase.Load
            myCam =新ICAM
            myCam.setFrameRate(20)
            myCam.initCam(PictureBox1.Handle.ToInt32)

        结束小组

        私人小组的button1_Click(发送者为对象,E作为EventArgs的)把手Button1.Click
            昏暗的图像作为位图
            图象= myCam.copyFrame(PictureBox1,新的RectangleF(0,0,PictureBox1.Width,PictureBox1.Height))
            昏暗克作为图形
            G = Graphics.FromImage(图)
            image.Save(迪尔,ImageFormat.Jpeg)
        结束小组
    末级
 

ICAM类:

 显式的选项在
期权严格的

公共类ICAM
#REGIONAPI /常量

    私人常量WS_CHILD作为整数=安培; H40000000
    私人常量WS_VISIBLE作为整数=安培; H10000000
    私人常量SWP_NOMOVE短=安培; H2S
    私人常量SWP_NOZORDER短=安培; H4S
    私人常量WM_USER短=安培; H400S
    私人常量WM_CAP_DRIVER_CONNECT为整数= WM_USER + 10
    私人常量WM_CAP_DRIVER_DISCONNECT为整数= WM_USER + 11
    私人常量WM_CAP_SET_VIDEOFORMAT为整数= WM_USER + 45
    私人常量WM_CAP_SET_ preVIEW作为整数= WM_USER + 50
    私人常量WM_CAP_SET_ preVIEWRATE作为整数= WM_USER + 52
    私人常量WM_CAP_GET_FRAME只要= 1084
    私人常量WM_CAP_COPY只要= 1054
    私人常量WM_CAP_START只要= WM_USER
    私人常量WM_CAP_STOP只要=(WM_CAP_START + 68)
    私人常量WM_CAP_SEQUENCE只要=(WM_CAP_START + 62)
    私人常量WM_CAP_SET_SEQUENCE_SETUP只要=(WM_CAP_START + 64)
    私人常量WM_CAP_FILE_SET_CAPTURE_FILEA只要=(WM_CAP_START + 20)

    私人声明SendMessage函数库USER32别名SendMessageA(BYVAL HWND作为整数,BYVAL WMSG作为整数,BYVAL的wParam短,lParam的BYVAL作为字符串)作为整数
    私人声明函数capCreateCaptureWindowA库avicap32.dll(BYVAL lpszWindowName作为字符串,BYVAL dwStyle为整数,BYVAL x As中整数,BYVAL y为整数,BYVAL nWidth为整数,nHeight参数BYVAL短,BYVAL hWndParent作为整数,BYVAL的NID作​​为整数)作为整数
    私人声明函数capGetDriverDescriptionA库avicap32.dll(BYVAL wDriver短,BYVAL lpszName作为字符串,BYVAL cbName作为整数,BYVAL lpszVer作为字符串,BYVAL cbVer为整数)作为布尔
    私人声明函数BitBlt库GDI32.DLL(BYVAL hdcDest作为IntPtr的,BYVAL nXDest作为整数,BYVAL nYDest作为整数,BYVAL nWidth为整数,BYVAL nHeight参数为整数,BYVAL hdcSrc作为IntPtr的,BYVAL nXSrc作为整数,BYVAL nYSrc作为整数,BYVAL dwRop作为的Int32)为布尔

#END地区

    私人的iDevice作为字符串
    私人hHwnd作为整数
    私人lwndC作为整数

    公共iRunning由于布尔

    私人CamFrameRate为整数= 15
    私人OutputHeight作为整数= 240
    私人OutputWidth作为整数= 360

    公用Sub resetCam()
        设定变更后重置相机
        如果iRunning然后
            closeCam()
            Application.DoEvents()

            如果setCam()= false,那么
                的MessageBox.show(Errror设置/重新设置摄像机)
            结束如果
        结束如果

    结束小组

    公用Sub initCam(BYVAL parentH为整数)
        获取手柄,并启动相机设置
        如果Me.iRunning = TRUE,则
            的MessageBox.show(相机已经在运行)
            退出小组
        其他

            hHwnd = capCreateCaptureWindowA(i设备,WS_VISIBLE或者WS_CHILD,0,0,OutputWidth,C短C(OutputHeight),parentH,0)


            如果setCam()= false,那么
                的MessageBox.show(错误设置相机)
            结束如果
        结束如果
    结束小组

    公用Sub setFrameRate(BYVAL愤怒长)
        '设定照相机的帧速率
        CamFrameRate = CINT(1000 /愤怒)

        resetCam()

    结束小组

    专用功能setCam()作为布尔
        将所有摄像机向上
        如果SendMessage函数(hHwnd,WM_CAP_DRIVER_CONNECT,C短C(的iDevice),CTYPE(0,字符串))= 1,则
            SendMessage函数(hHwnd,WM_CAP_SET_ preVIEWRATE,C短C(CamFrameRate),CTYPE(0,字符串))
            SendMessage函数(hHwnd,WM_CAP_SET_ preVIEW,1,CTYPE(0,字符串))
            Me.iRunning = TRUE
            返回TRUE
        其他
            Me.iRunning =假
            返回False
        结束如果
    端功能

    公共功能closeCam()作为布尔
        关闭摄像头
        如果Me.iRunning然后
            closeCam = CBool​​函数(SendMessage函数(hHwnd,WM_CAP_DRIVER_DISCONNECT,0,CTYPE(0,字符串)))
            Me.iRunning =假
        结束如果
    端功能

    公共职能copyFrame(BYVAL SRC作为图片框,BYVAL RECT作为的RectangleF)为位图
        如果iRunning然后
            昏暗srcPic作为图形= src.CreateGraphics
            昏暗srcBmp作为新位图(src.Width,src.Height,srcPic)
            昏暗SRCMEM作为图形= Graphics.FromImage(srcBmp)


            昏暗hdc1分区作为IntPtr的= srcPic.GetHdc
            昏暗HDC2作为IntPtr的= srcMem.GetHdc

            的BitBlt(HDC2,0,0,CINT(rect.Width),_
              CINT(rect.Height),hdc1分区,CINT(rect.X),CINT(rect.Y),13369376)

            copyFrame = CTYPE(srcBmp.Clone(),位​​图)

            '清理
            srcPic.ReleaseHdc(hdc1分区)
            srcMem.ReleaseHdc(HDC2)
            srcPic.Dispose()
            srcMem.Dispose()
        其他
            的MessageBox.show(相机不运行!)
        结束如果
    端功能

    公共功能FPS()作为整数
        返回CINT(1000 /(CamFrameRate))
    端功能

末级
 

解决方案

终于让我找到了这一信息。问题的解决方案出现在Windows 7/8

首先,你需要这个API函数

 私人声明函数的GetTickCount库KERNEL32()只要
 
VB.net程序用什么编写

您拨打则...在 capCreateCaptureWindowA()你必须等待1秒处理事件,(注:睡眠不工作一样)

  IniTime =的GetTickCount()
虽然的GetTickCount()< (IniTime + 1000)
的DoEvents
蜿蜒
 

然后调用 WM_CAP_DRIVER_CONNECT ..这就是它

So, I am building an application which needs to have access to a single webcam on the computer, the problem is that whenever I run the application I get a dialog from Windows asking to select a Video Source. I would like to make it programatically select the standard device. Does anybody have any idea on how should I approach this?

Main App code:

Imports WindowsApplication1.iCam
Imports System.Drawing.Imaging

    Public Class Form1
        Dim myCam As iCam
        Dim Dir As String
        Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
            myCam = New iCam
            myCam.setFrameRate(20)
            myCam.initCam(PictureBox1.Handle.ToInt32)

        End Sub

        Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
            Dim image As Bitmap
            image = myCam.copyFrame(PictureBox1, New RectangleF(0, 0, PictureBox1.Width, PictureBox1.Height))
            Dim g As Graphics
            g = Graphics.FromImage(image)
            image.Save(Dir, ImageFormat.Jpeg)
        End Sub
    End Class

iCam Class:

Option Explicit On 
Option Strict On

Public Class iCam
#Region "Api/constants"

    Private Const WS_CHILD As Integer = &H40000000
    Private Const WS_VISIBLE As Integer = &H10000000
    Private Const SWP_NOMOVE As Short = &H2S
    Private Const SWP_NOZORDER As Short = &H4S
    Private Const WM_USER As Short = &H400S
    Private Const WM_CAP_DRIVER_CONNECT As Integer = WM_USER + 10
    Private Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_USER + 11
    Private Const WM_CAP_SET_VIDEOFORMAT As Integer = WM_USER + 45
    Private Const WM_CAP_SET_PREVIEW As Integer = WM_USER + 50
    Private Const WM_CAP_SET_PREVIEWRATE As Integer = WM_USER + 52
    Private Const WM_CAP_GET_FRAME As Long = 1084
    Private Const WM_CAP_COPY As Long = 1054
    Private Const WM_CAP_START As Long = WM_USER
    Private Const WM_CAP_STOP As Long = (WM_CAP_START + 68)
    Private Const WM_CAP_SEQUENCE As Long = (WM_CAP_START + 62)
    Private Const WM_CAP_SET_SEQUENCE_SETUP As Long = (WM_CAP_START + 64)
    Private Const WM_CAP_FILE_SET_CAPTURE_FILEA As Long = (WM_CAP_START + 20)

    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Short, ByVal lParam As String) As Integer
    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 Short, ByVal hWndParent As Integer, ByVal nID As Integer) As Integer
    Private Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Short, ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, ByVal cbVer As Integer) As Boolean
    Private Declare Function BitBlt Lib "GDI32.DLL" (ByVal hdcDest As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As Int32) As Boolean

#End Region

    Private iDevice As String
    Private hHwnd As Integer
    Private lwndC As Integer

    Public iRunning As Boolean

    Private CamFrameRate As Integer = 15
    Private OutputHeight As Integer = 240
    Private OutputWidth As Integer = 360

    Public Sub resetCam()
        'resets the camera after setting change
        If iRunning Then
            closeCam()
            Application.DoEvents()

            If setCam() = False Then
                MessageBox.Show("Errror Setting/Re-Setting Camera")
            End If
        End If

    End Sub

    Public Sub initCam(ByVal parentH As Integer)
        'Gets the handle and initiates camera setup
        If Me.iRunning = True Then
            MessageBox.Show("Camera Is Already Running")
            Exit Sub
        Else

            hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, OutputWidth, CShort(OutputHeight), parentH, 0)


            If setCam() = False Then
                MessageBox.Show("Error setting Up Camera")
            End If
        End If
    End Sub

    Public Sub setFrameRate(ByVal iRate As Long)
        'sets the frame rate of the camera
        CamFrameRate = CInt(1000 / iRate)

        resetCam()

    End Sub

    Private Function setCam() As Boolean
        'Sets all the camera up
        If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, CShort(iDevice), CType(0, String)) = 1 Then
            SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, CShort(CamFrameRate), CType(0, String))
            SendMessage(hHwnd, WM_CAP_SET_PREVIEW, 1, CType(0, String))
            Me.iRunning = True
            Return True
        Else
            Me.iRunning = False
            Return False
        End If
    End Function

    Public Function closeCam() As Boolean
        'Closes the camera
        If Me.iRunning Then
            closeCam = CBool(SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, 0, CType(0, String)))
            Me.iRunning = False
        End If
    End Function

    Public Function copyFrame(ByVal src As PictureBox, ByVal rect As RectangleF) As Bitmap
        If iRunning Then
            Dim srcPic As Graphics = src.CreateGraphics
            Dim srcBmp As New Bitmap(src.Width, src.Height, srcPic)
            Dim srcMem As Graphics = Graphics.FromImage(srcBmp)


            Dim HDC1 As IntPtr = srcPic.GetHdc
            Dim HDC2 As IntPtr = srcMem.GetHdc

            BitBlt(HDC2, 0, 0, CInt(rect.Width), _
              CInt(rect.Height), HDC1, CInt(rect.X), CInt(rect.Y), 13369376)

            copyFrame = CType(srcBmp.Clone(), Bitmap)

            'Clean Up 
            srcPic.ReleaseHdc(HDC1)
            srcMem.ReleaseHdc(HDC2)
            srcPic.Dispose()
            srcMem.Dispose()
        Else
            MessageBox.Show("Camera Is Not Running!")
        End If
    End Function

    Public Function FPS() As Integer
        Return CInt(1000 / (CamFrameRate))
    End Function

End Class

解决方案

Finally I Found a solution for this.The problem happen in Windows 7 / 8

First you need this API function

Private Declare Function GetTickCount Lib "kernel32" () As Long

Then... after you call capCreateCaptureWindowA() you have to wait 1 second processing events, (note: sleep don't work the same)

IniTime = GetTickCount()
While GetTickCount() < (IniTime + 1000)
DoEvents
Wend

then you call WM_CAP_DRIVER_CONNECT.. and THAT's IT