none
webcam RRS feed

  • Pergunta

  • 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

    Essa é a tela que recebo após clicar iniciar

    segunda-feira, 28 de março de 2016 13:48

Respostas

  • 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.

    • Marcado como Resposta Marcos SJ segunda-feira, 28 de março de 2016 15:08
    segunda-feira, 28 de março de 2016 15:08

Todas as Respostas

  • 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.

    • Marcado como Resposta Marcos SJ segunda-feira, 28 de março de 2016 15:08
    segunda-feira, 28 de março de 2016 15:08
  • 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.
    segunda-feira, 28 de março de 2016 18:37
  • 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.

    segunda-feira, 28 de março de 2016 19:26

  • 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

    na mesma rotina onde deveria mostrar a imagem

    segunda-feira, 28 de março de 2016 21:22
  • Olá Roberto. Bom dia. Ainda estou com dificuldade com essa rotina, você teve tempo de verificar se pode me ajudar?

    terça-feira, 5 de abril de 2016 13:39