Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

renatho

Uma classe para abrir a camera

Por , em Visual Basic

Recommended Posts

renatho    0

renatho
Postado

Pessoal me desculpem, sou meio leigo em vb.net, tenho um projeto para conectar com a camera, so que abro esse codigo

em dois forms, um de cadastro e outro de alteração de produtos. o codigo da camera e pra tirar foto do produto. Eu nao queria duplicar o codigo , então porfavor quem puder me ajudar a criar uma classe para esse codigo e chamar suas funçoes e metodos quando necessario. segue abaixo o codigo no form alterar que o mesmo do de cadastro para conectar com a camera:

 

Imports System.Runtime.InteropServices

 

Public Class AlterarFoto

 

 

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 - (identifica 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 AlterarPart_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load

dtpNewData.MaxDate = DateTime.Today

lblCaminhoArquivo.Text = "Sem Imagem"

'verifica e carrega os dispositivos

carregaDispositivos()

If lstDispositivos.Items.Count > 0 Then

btnIniciar.Enabled = True

lstDispositivos.SelectedIndex = 0

btnIniciar.Enabled = True

Else

lstDispositivos.Items.Add("Não há dispositivo de captura instalado.")

btnIniciar.Enabled = False

End If

btnParar.Enabled = False

btnSalvar.Enabled = False

picFoto.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)

x += 1

Loop Until bRetorna = False

End Sub

Private Sub abreJanelaVisualizacao()

Dim iHeight As Integer = picFoto.Height

Dim iWidth As Integer = picFoto.Width

 

 

' Abre a janela de visualização no picturebox

hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, _

480, picFoto.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, picFoto.Width, picFoto.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 btnOk_Click(sender As System.Object, e As System.EventArgs) Handles btnOk.Click

lstDispositivos.Items.Clear()

Me.Close()

End Sub

 

Private Sub btnIniciar_Click(sender As System.Object, e As System.EventArgs) Handles btnIniciar.Click

iDevice = lstDispositivos.SelectedIndex

If iDevice <> -1 Then

abreJanelaVisualizacao()

Else

MsgBox("Selecione um dispositivo de video...")

End If

btnProcurar.Enabled = False

End Sub

 

Private Sub btnParar_Click(sender As System.Object, e As System.EventArgs) Handles btnParar.Click

fechaJanelaVisualizacao()

btnSalvar.Enabled = False

btnIniciar.Enabled = True

btnParar.Enabled = False

btnProcurar.Enabled = True

End Sub

Private Sub btnSalvar_Click(sender As System.Object, 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)

picFoto.Image = bmap

fechaJanelaVisualizacao()

btnSalvar.Enabled = False

btnParar.Enabled = False

btnIniciar.Enabled = True

btnProcurar.Enabled = True

 

If sfdImage.ShowDialog = System.Windows.Forms.DialogResult.OK Then

lblCaminhoArquivo.Text = sfdImage.FileName

bmap.Save(sfdImage.FileName, Imaging.ImageFormat.Bmp)

Else

picFoto.Image = Nothing

End If

'Fecha o som

mciSendString("close " & musicAlias, CStr(0), 0, 0)

 

End If

End Sub

 

Private Sub btnProcurar_Click(sender As System.Object, e As System.EventArgs) Handles btnProcurar.Click

If OpenImage.ShowDialog = DialogResult.OK Then

picFoto.Image = System.Drawing.Image.FromFile(OpenImage.FileName)

lblCaminhoArquivo.Text = OpenImage.FileName

Else

MsgBox("Cancelado pelo Usuário")

End If

End Sub

End Class

Compartilhar este post

Link para o post
Compartilhar em outros sites

KhaosDoctor    242

KhaosDoctor
Postado

Primeiro, ponha um <code> ai que não da pra ler nada...

 

Bom, uma dica é substituir tudo que é private ou que não tem identificação por "Public Shared". Isso dentro de uma classe, assim você pode chamá-los.

Compartilhar este post

Link para o post
Compartilhar em outros sites

renatho    0

renatho
Postado

Desculpe, sou novo no forum, e novo tbm na linguagem mas segue abaixo o codigo:

 

Imports System.Runtime.InteropServices
Public Class AlterarFoto

   '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 - (identifica 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 AlterarPart_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
       dtpNewData.MaxDate = DateTime.Today
       lblCaminhoArquivo.Text = "Sem Imagem"
       'verifica e carrega os dispositivos
       carregaDispositivos()
       If lstDispositivos.Items.Count > 0 Then
           btnIniciar.Enabled = True
           lstDispositivos.SelectedIndex = 0
           btnIniciar.Enabled = True
       Else
           lstDispositivos.Items.Add("Não há dispositivo de captura instalado.")
           btnIniciar.Enabled = False
       End If
       btnParar.Enabled = False
       btnSalvar.Enabled = False
       picFoto.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)
           x += 1
       Loop Until bRetorna = False
   End Sub
   Private Sub abreJanelaVisualizacao()
       Dim iHeight As Integer = picFoto.Height
       Dim iWidth As Integer = picFoto.Width


       ' Abre a janela de visualização no picturebox
       hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, _
           480, picFoto.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, picFoto.Width, picFoto.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 btnOk_Click(sender As System.Object, e As System.EventArgs) Handles btnOk.Click
       lstDispositivos.Items.Clear()
       Me.Close()
   End Sub

   Private Sub btnIniciar_Click(sender As System.Object, e As System.EventArgs) Handles btnIniciar.Click
       iDevice = lstDispositivos.SelectedIndex
       If iDevice <> -1 Then
           abreJanelaVisualizacao()
       Else
           MsgBox("Selecione um dispositivo de video...")
       End If
       btnProcurar.Enabled = False
   End Sub

   Private Sub btnParar_Click(sender As System.Object, e As System.EventArgs) Handles btnParar.Click
       fechaJanelaVisualizacao()
       btnSalvar.Enabled = False
       btnIniciar.Enabled = True
       btnParar.Enabled = False
       btnProcurar.Enabled = True
   End Sub

   Private Sub btnSalvar_Click(sender As System.Object, 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)
           picFoto.Image = bmap
           fechaJanelaVisualizacao()
           btnSalvar.Enabled = False
           btnParar.Enabled = False
           btnIniciar.Enabled = True
           btnProcurar.Enabled = True

           If sfdImage.ShowDialog = System.Windows.Forms.DialogResult.OK Then
               lblCaminhoArquivo.Text = sfdImage.FileName
               bmap.Save(sfdImage.FileName, Imaging.ImageFormat.Bmp)
           Else
               picFoto.Image = Nothing
           End If


       End If
   End Sub

   Private Sub btnProcurar_Click(sender As System.Object, e As System.EventArgs) Handles btnProcurar.Click
       If OpenImage.ShowDialog = DialogResult.OK Then
           picFoto.Image = System.Drawing.Image.FromFile(OpenImage.FileName)
           lblCaminhoArquivo.Text = OpenImage.FileName
       Else
           MsgBox("Cancelado pelo Usuário")
       End If
   End Sub
End Class

Compartilhar este post

Link para o post
Compartilhar em outros sites

KhaosDoctor    242

KhaosDoctor
Postado

Então, se você quer colocar tudo isso em uma classe ou um módulo para poder simplesmente chamar ou instanciar depois, substitua tudo que não tem nada ou tem "private" por "public Shared", crie uma classe, copie todo esse código dentro dela e substitua cada sub por "Public Shared Sub" assim você chama como:

 

Classe.Método()

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos Visual Basic
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito