Fabrika LAB: WebCam Video

Imports AForge.Video.DirectShow

Public Class frmCamera

    Private videoDevices As FilterInfoCollection
    Private videoCapabilities As VideoCapabilities()

    Private videoDevice As VideoCaptureDevice

    Private Sub EnumerateVideoDevices()
        ' enumerate video devices
        videoDevices = New FilterInfoCollection(FilterCategory.VideoInputDevice)

        If videoDevices.Count <> 0 Then
            ' add all devices to combo
            For Each device As FilterInfo In videoDevices
                ComboBoxSources.Items.Add(device.Name)
            Next
        Else
            ComboBoxSources.Items.Add("No DirectShow devices found")
        End If

        ComboBoxSources.SelectedIndex = 0
    End Sub

    Private Sub EnumerateVideoModes(device As VideoCaptureDevice)
        ' get resolutions for selected video source
        Me.Cursor = Cursors.WaitCursor

        ComboBoxModes.Items.Clear()

        Try
            videoCapabilities = videoDevice.VideoCapabilities

            For Each capabilty As VideoCapabilities In videoCapabilities
                If Not ComboBoxModes.Items.Contains(capabilty.FrameSize) Then
                    ComboBoxModes.Items.Add(capabilty.FrameSize)
                End If
            Next

            If videoCapabilities.Length = 0 Then
                ComboBoxModes.Items.Add("Not supported")
            End If

            ComboBoxModes.SelectedIndex = 0
        Finally
            Me.Cursor = Cursors.[Default]
        End Try

    End Sub

    Private Sub frmCamera_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        EnumerateVideoDevices()
    End Sub

    Private Sub ComboBoxSources_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboBoxSources.SelectedIndexChanged
        If videoDevices.Count <> 0 Then
            videoDevice = New VideoCaptureDevice(videoDevices(ComboBoxSources.SelectedIndex).MonikerString)
            EnumerateVideoModes(videoDevice)
        End If
    End Sub

    Private Sub ButtonStart_Click(sender As Object, e As EventArgs) Handles ButtonStart.Click
        CameraStart()
    End Sub

    Private Sub ButtonStop_Click(sender As Object, e As EventArgs) Handles ButtonStop.Click
        CameraStop()
    End Sub

    Private Sub CameraStart()
        If videoDevice IsNot Nothing Then
            If (videoCapabilities IsNot Nothing) AndAlso (videoCapabilities.Length <> 0) Then
                videoDevice.DesiredFrameSize = DirectCast(ComboBoxModes.SelectedItem, Size)
            End If
            VideoSourcePlayer1.VideoSource = videoDevice
            VideoSourcePlayer1.Start()
        End If
    End Sub

    Private Sub CameraStop()
        If VideoSourcePlayer1.VideoSource IsNot Nothing Then
            ' stop video device
            VideoSourcePlayer1.SignalToStop()
            VideoSourcePlayer1.WaitForStop()
            VideoSourcePlayer1.VideoSource = Nothing
        End If
    End Sub

    Private Sub VideoSourcePlayer1_NewFrame(sender As Object, ByRef image As Bitmap) Handles VideoSourcePlayer1.NewFrame
        ' add overlay
        Dim g As Graphics = Graphics.FromImage(image)
        g.DrawString("Augmented reality?", New Font("Arial", 16), Brushes.Black, New Rectangle(10, 10, 200, 50))
        g.Dispose()
    End Sub
End Class