WebCam + VB

[vinnydracon 0]

Opa pessoal td bem?

então gostaria de saber quais são os componentes necessários para fzer com q o VB possa reconhecer a webCam.

e capturar imagens tb...^^

o VB q utilizo é o VB2005 c/ SP1 ;)

então é só isso por agora q eu gostaria de saber^^

abraços...e aguardo resposta

[dark_devil 0]

Boas vinnydracon,

 

Esse código, eu acho que vai quebra o galho... usa a DLL avicap32 que está na system32 do XP

 

''(((( COLOQUE UMA PICTURE BOX NO SEU FORM ))))))
''(((( COLOQUE UM BOTÃO COMMAND1 NO SEU FORM )))))

''DECLARACOES
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal nID As Long) As Long
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "USER32" () As Long
Private Const WM_CAP_DRIVER_CONNECT As Long = 1034
Private Const WM_CAP_DRIVER_DISCONNECT As Long = 1035
Private Const WM_CAP_GRAB_FRAME As Long = 1084
Private Const WM_CAP_EDIT_COPY As Long = 1054
Private Const WM_CAP_DLG_VIDEOFORMAT As Long = 1065
Private Const WM_CAP_DLG_VIDEOSOURCE As Long = 1066
Private Const WM_CLOSE = &H10
Private mCapHwnd As Long

Private Sub Form_Load()
''Inicia a câmera
mCapHwnd = capCreateCaptureWindow("My Own Capture Window", 0, 0, 0, 320, 240, Me.hwnd, 0)
SendMessage mCapHwnd, WM_CAP_DRIVER_CONNECT, 0, 0
End Sub

Private Sub Form_Terminate()
''Desliga a câmera
SendMessage mCapHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0
End Sub


Private Sub Command1_Click()
''Captura a imagem atual, se você quiser pode colocar esse cod num Timer para capturar continuamente....
Clipboard.Clear
SendMessage mCapHwnd, WM_CAP_GRAB_FRAME, 0, 0
SendMessage mCapHwnd, WM_CAP_EDIT_COPY, 0, 0
Picture1.Picture = Clipboard.GetData
End Sub

[vinnydracon 0]

humm...

me surgiu algumas perguntas o q ser aquele "lParam As Any", já q esse Any ele ñ reconhece...

gostaria de saber se tá faltando alguma coisa ou se é a assim msm...

e a outra pergunta é a de q tipo tenho a pictureBox lá e tal, mas assim to tendo um probleminha aqui com esse código q você postou ele ñ reconhece o "Me.hwnd" dai tentei utilizar o "Me.Handle", só q ele ñ mostra nd na picturebox.

 

mCapHwnd = capCreateCaptureWindow("My Own Capture Window", 0, 0, 0, 320, 240, Me.hwnd, 0)

 

aquele parâmetro da pictureBox "picture1.picture" ñ seria "picture1.Image"?

e tbm na parte do Clipboard q pssa os valores p/ a pisture...o objeto q você colocou é assim "picture1.GetData", mas esse parâmetro tá dando erro de q ele ñ pertence

 

"Error 1 Argument not specified for parameter 'format' of 'Public Shared Function GetData(format As String) As Object'. C:\Documents and Settings\Vinicius\Configurações locais\Dados de aplicativos\Temporary Projects\teste\Form1.vb 29 25 teste"

 

esse ai é o erro... ñ entendi mta coisa...to fzendo do msm jeito q tá ai e ñ tá acontecendo nd...

 

e tbm como q posso fzer p/ q salve essa imagem?

 

vlew pela atenção

qq coisa pode pegar o meu msn p/ q possa ser esclarecido isso se você ficar c/ mais alguma dúvida...^^

em relação a isso...ok?

abraços e aguardo resposta

[dark_devil 0]

Boas cara,

 

tenta com esse codigo o outro que lhe pasei era do vb6, foi engano...

 

Para iniciar declare o namespace : Imports System.Runtime.InteropServices;

A seguir vamos declarar as funções das APIs usadas e as constantes relacionadas no formulário:
'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 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

Agora vamos definir o código para cada evento :

1- No evento Load do formulário vamos definir a carga dos dispositivos e a exibição do nome do mesmo no ListBox;
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.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

A rotina carregaDispositivos() possui o seguinte código:
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)
	x += 1
Loop Until bRetorna = False
End Sub

Na rotina abreJanelaVisualização() iremos conectar com o drive e exibir as informações;
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, 640, _
480, 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

O código do evento Click do botão iniciar abre a janela de visualização após obter o dispositivo instalado
Private Sub btnIniciar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnIniciar.Click
	iDevice = lstDispositivos.SelectedIndex
   abreJanelaVisualizacao()
End Sub

A rotina fechaJanelaVisualização() envia uma mensagem para desconexão da janela e destrói a janela;
Private Sub fechaJanelaVisualizacao()
  ' Desconecta do dispositivo
  SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, iDevice, 0)

  ' fecha a chama a janela
  DestroyWindow(hHwnd)
End Sub
 

No evento Click do botão Parar fechamos a janela e definimos o estado de habilitação dos botões:
Private Sub btnParar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnParar.Click
   fechaJanelaVisualizacao()
   btnSalvar.Enabled = False
   btnIniciar.Enabled = True
   btnParar.Enabled = False
End Sub

O código do evento Click do botão Salvar é o seguinte:
Private Sub btnSalvar_Click(ByVal sender As System.Object, ByVal e As System.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

	 If sfdImage.ShowDialog = System.Windows.Forms.DialogResult.OK Then
		  bmap.Save(sfdImage.FileName, Imaging.ImageFormat.Bmp)
	 End If

End If
End Sub

Private Sub Form1_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
If btnParar.Enabled Then
	 fechaJanelaVisualizacao()
End If
End Sub

Atenção que o codigo pode percisar de algumas alterações e ao nome das variaveis. Utilize somente o que achar necessario.

 

 

Comprimentos,

[vinnydracon 0]

vlew ae Dark_devil...

precisava dessa ajuda...^^

agora to vendo aqui o q precisa alterar ou ñ...

eu já te adicionei cara no MSN ok?

 

abraços e vlew ae e desculpa qq coisa...

 

bom fim de semana