webcam

Question

Preciso fazer um software de cadastro que capture imagem.

Obtive do macoratti o software abaixo porem quando clico no botão Iniciar recebo uma tela totalmente preta.

Agradeço toda ajuda que vier.

Heis abaixo o software e a única tela dele.

Imports System.ComponentModel
Imports System.Runtime.InteropServices
Public Class Form1
    'constantes usadas na DLL
    Const WM_CAP As Short = &H400S
    Const WM_CAP_DRIVER_CONNECT As Integer = WM_CAP + 10
    Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_CAP + 11
    Const WM_CAP_EDIT_COPY As Integer = WM_CAP + 30
    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
    Dim iDevice As Integer = 0 ' ID do dispositivo atual
    Dim NomeDevice As String = "" ' Nome do dispositivo atual
    Dim hHwnd As Integer ' manipulador da janela do visualizador
    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 Integer
    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
    'A função DestroyWindow destroi a janela especificada. Envia as mensagens WM_DESTROY e WM_NCDESTROY para a janela para destivá-la e remove o foco do teclado da mesma 
    'Library - User32   Parametros - hWnd - (identica a janela a ser destruida)
    'Retorna um valor diferente de zero se for executada com sucesso, 'caso contrario retorna zero
    Declare Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean
    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
    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 Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        'verifica e carrega os dispositivos
        carregaDispositivos()
        ' se encontrou dispostivos instalados então exibe
        If lstDispositivos.Items.Count > 0 Then
            btnIniciar.Enabled = True
            lstDispositivos.SelectedIndex = 0
            btnIniciar.Enabled = True
        Else
            lstDispositivos.Items.Add("Não dispositivo de captura instalado.")
            btnIniciar.Enabled = False
        End If
        btnParar.Enabled = False
        btnSalvar.Enabled = False
        picCaptura.SizeMode = PictureBoxSizeMode.StretchImage
    End Sub
    Private Sub carregaDispositivos()
        Dim strNome As String = Space(100)
        Dim strVer As String = Space(100)
        Dim bRetorna As Boolean
        Dim x As Integer = 0
        '' Carrega os dispositivos em lstDevices
        Do
            ' Obtem o nome e a versão Driver
            bRetorna = capGetDriverDescriptionA(x, strNome, 100, strVer, 100)
            ' se existir um dispositivo inclui o nome da lista
            If bRetorna Then
                lstDispositivos.Items.Add(strNome.Trim)
                NomeDevice = Mid(strNome.Trim, 1, 35)
            End If
            x += 1
        Loop Until bRetorna = False
    End Sub
    Private Sub abreJanelaVisualizacao()
        Dim iHeight As Integer = picCaptura.Height
        Dim iWidth As Integer = picCaptura.Width
        ' Abre a janela de visualização no picturebox -
        hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 320, 240, picCaptura.Handle.ToInt32, 0)
        ' Conecta com o drive
        If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0) Then
            'Define a escala de previsão
            SendMessage(hHwnd, WM_CAP_SET_SCALE, True, 0)
            'Define a taxa de visualização em milisegundos
            SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0)
            'Iniciar a visualização da imagem a partir da camara
            SendMessage(hHwnd, WM_CAP_SET_PREVIEW, True, 0)
            ' Redimensiona a janela para se ajustar no picturebox
            SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, picCaptura.Width, picCaptura.Height, SWP_NOMOVE Or SWP_NOZORDER)
            btnSalvar.Enabled = True
            btnParar.Enabled = True
            btnIniciar.Enabled = False
        Else
            ' Erro de conexão fecha a janela de dispostivos
            DestroyWindow(hHwnd)
            btnSalvar.Enabled = False
        End If
    End Sub
    Private Sub fechaJanelaVisualizacao()
        ' Desconecta do dispositivo
        SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, iDevice, 0)
        ' fecha a chama a janela
        DestroyWindow(hHwnd)
    End Sub
    Private Sub btnIniciar_Click(sender As Object, e As EventArgs) Handles btnIniciar.Click
        iDevice = lstDispositivos.SelectedIndex
        abreJanelaVisualizacao()
    End Sub
    Private Sub btnParar_Click(sender As Object, e As EventArgs) Handles btnParar.Click
        fechaJanelaVisualizacao()
        btnSalvar.Enabled = False
        btnIniciar.Enabled = True
        btnParar.Enabled = False
    End Sub
    Private Sub btnSalvar_Click(sender As Object, e As EventArgs) Handles btnSalvar.Click
        Dim dados As IDataObject
        Dim bmap As Image
        ' Copia a imagem para o clipboard
        SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)
        ' Obtem a imagem do clipboard e converte para bitmap
        dados = Clipboard.GetDataObject()
        If dados.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
            bmap = CType(dados.GetData(GetType(System.Drawing.Bitmap)), Image)
            picCaptura.Image = bmap
            fechaJanelaVisualizacao()
            btnSalvar.Enabled = False
            btnParar.Enabled = False
            btnIniciar.Enabled = True
            Dim sfdImage As New SaveFileDialog()
            sfdImage.Filter = "Jpeg Image|*.jpg|Bitmap Image|*.bmp|Gif Image|*.gif"
            sfdImage.Title = "Salvar um arquivo de imagem"
            sfdImage.FileName = "Image001"
            If sfdImage.ShowDialog = System.Windows.Forms.DialogResult.OK Then
                bmap.Save(sfdImage.FileName, Imaging.ImageFormat.Bmp)
            End If
            ''essa parte captura a mensagem do picturebox e salva onde e com o nome que eu especificar
            'Dim path As String = "C:\foto\teste.jpg"
            'Dim img = New Bitmap(imgFoto.Image)
            'img.Save(path, System.Drawing.Imaging.ImageFormat.Jpeg)
        End If
    End Sub
    Private Sub Form1_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
        If btnParar.Enabled Then
            fechaJanelaVisualizacao()
        End If
    End Sub
End Class

Answer 1

Bom dia Manoel,

Sugiro que você olhe um artigo oficial da Microsoft sobre isso.

How To Create Webcam Capture

---

Att., Roberto Alves

Por favor, lembre-se de Marcar como Resposta as postagens que resolveram o seu problema. Essa é uma maneira comum de reconhecer aqueles que o ajudaram e fazer com que seja mais fácil para os outros visitantes encontrarem a resolução mais tarde.

Answer 2

Olá Roberto. Boa Tarde. Obrigado pela sua atenção e por ter me atendido. O exemplo do macoratti que falei é exatamente o mesmo exemplo do link citado, até os nomes das variáveis são os mesmos, o macoratti apenas traduziu os comentários e colou tudo da MS rsrsrs. A Única diferença é que na Microsoft as declarações estão em um modulo separado. Para evitar qualquer dúvida, também separei as declarações em um módulo. Mas infelizmente continua o mesmo. Testei inclusive no antigo VB6 com o Activex VideoCapX porém continua dando o mesmo erro. Nos dois casos da pra perceber que a câmera conecta quando passa pela rotina de conexão e acende o led ao lado da câmera que no meu caso é no notebook. O software padrão da (Lenovo Notebook) que acessa a câmera está funcionando normalmente portanto não é defeito da câmera. Para complementar vou passar alguns dados do que estou usando pra ver se ajuda: Equipamento: NoteBook Lenovo com intel i7 4Gb e HD 1Tb. Sistema: Windows 10. Plataforma: VS2015. Continuo no aguardo. Abraço.

Answer 3

Manoel,

Se aprofundando mais então, segue um exemplo mais bem estruturado.

WebCam Library for WinForm and WPF with C# and VB.NET

---

Att., Roberto Alves

Por favor, lembre-se de Marcar como Resposta as postagens que resolveram o seu problema. Essa é uma maneira comum de reconhecer aqueles que o ajudaram e fazer com que seja mais fácil para os outros visitantes encontrarem a resolução mais tarde.

Answer 4

Para rodar o software desse link baixei e inclui uma nova referencia 'WebCam_Capture'

porém ao clicar no botão iniciar que chama a Class 'WebCam' abaixo - tivemos novamente o mesmo erro erro logo após o led ao lado da câmera acender. Dessa vez vem com a mensagem que coloquei no final.

  Private Sub bntStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bntStart.Click
        webcam.Start()
  End Sub

Imports System
Imports System.IO
Imports System.Linq
Imports System.Text
Imports WebCam_Capture
Imports System.Collections.Generic

    'Design by Pongsakorn Poosankam
    Class WebCam
        Private webcam As WebCamCapture
        Private _FrameImage As System.Windows.Forms.PictureBox
        Private FrameNumber As Integer = 30
        Public Sub InitializeWebCam(ByRef ImageControl As System.Windows.Forms.PictureBox)
            webcam = New WebCamCapture()
            webcam.FrameNumber = CULng((0))
            webcam.TimeToCapture_milliseconds = FrameNumber
            AddHandler webcam.ImageCaptured, AddressOf webcam_ImageCaptured
            _FrameImage = ImageControl
        End Sub

        Private Sub webcam_ImageCaptured(ByVal source As Object, ByVal e As WebcamEventArgs)
            _FrameImage.Image = e.WebCamImage
        End Sub

        Public Sub Start()
            webcam.TimeToCapture_milliseconds = FrameNumber
            webcam.Start(0)
        End Sub

        Public Sub [Stop]()
            webcam.[Stop]()
        End Sub

        Public Sub [Continue]()
            ' change the capture time frame
            webcam.TimeToCapture_milliseconds = FrameNumber

            ' resume the video capture from the stop
            webcam.Start(Me.webcam.FrameNumber)
        End Sub

        Public Sub ResolutionSetting()
            webcam.Config()
        End Sub

        Public Sub AdvanceSetting()
            webcam.Config2()
        End Sub

    End Class

Answer 5

Olá Roberto. Bom dia. Ainda estou com dificuldade com essa rotina, você teve tempo de verificar se pode me ajudar?