VB .NET - Usando uma WebCam (de novo)

Este pequeno projeto que encontrei no site http://www.vbforums.com/showthread.php?p=2048466 trás um exemplo bem simples de como usar uma webcam com o Visual Basic .NET.(Eu ja tratei desse assunto em outro artigo)

Ele define uma classe chamada iCam.vb que utiliza algumas APIs que fazem todo o serviço para ativar , parar e resetar a webcam.

Veja imagem da minha web cam (Microsoft Web Cam) usando o programa.

O código da classe é dado a seguir:

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

 

Podemos inclusive definir a velocidade dos quadros e também capturar as imagens e imprimi-las:

Abaixo imagem feita com minha web cam usando o programa:

Simples assim, só com o VB .NET.

Obs: Eu tenho uma webcam da Microsoft e não tive problemas em usar e testar o programa.

Pegue projeto completo aqui: WebCamViewer.zip

Efésios 1:10-12 "para a dispensação da plenitude dos tempos, de fazer convergir em Cristo todas as coisas, tanto as que estão nos céus como as que estão na terra, nele, digo, no qual também fomos feitos herança, havendo sido predestinados conforme o propósito daquele que faz todas as coisas segundo o conselho da sua vontade, com o fim de sermos para o louvor da sua glória, nós, os que antes havíamos esperado em Cristo;"

Veja os Destaques e novidades do SUPER DVD Visual Basic (sempre atualizado) : clique e confira !

Quer migrar para o VB .NET ?

Quer aprender C# ??

Quer aprender os conceitos da Programação Orientada a objetos ?

Quer aprender o gerar relatórios com o ReportViewer no VS 2013 ?

 Gostou ?   Compartilhe no Facebook   Compartilhe no Twitter
 

Referências:

José Carlos Macoratti