Permalink
Browse files

Subida una clase para tomar capturas de la webcam VB.NET 2010

  • Loading branch information...
angelbroz committed Jun 28, 2010
1 parent 0127687 commit 434df4d4fa3780c07a3e5f7563654677afb58bf5
Showing with 175 additions and 0 deletions.
  1. +175 −0 ABWebCamTools.vb
View
@@ -0,0 +1,175 @@
+Imports System.Windows.Forms
+Imports System.Drawing
+Imports System.Runtime.InteropServices
+Module ABWebCamTools
+
+ Public Class ABWebCamera
+#Region "Apis y Constantes"
+ ' Constantesss
+ 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_SET_SCALE = WM_CAP_START + 53
+ 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 Const WM_CAP_EDIT_COPY = WM_CAP_START + 30
+ 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 SWP_NOSIZE = 1
+ Private Const HWND_BOTTOM = 1
+
+ ' Api's
+ 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 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 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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal Msg As Integer, ByVal wParam As Integer, <MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Integer
+ Private 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
+#End Region
+
+ Private _Device As String
+ Private _hWnd As Integer
+
+ Private _FramesPorrSegundo As Integer = 30
+ Private OutputHeight As Integer = 240
+ Private OutputWidth As Integer = 360
+
+ Private WithEvents _Picture As PictureBox
+
+ Public Property Running() As Boolean
+
+
+
+
+ Public Property FramesPorSegundo() As Integer
+ Get
+ Return _FramesPorrSegundo
+ End Get
+ Set(ByVal value As Integer)
+ _FramesPorrSegundo = value
+ ReiniciarCamera()
+ End Set
+ End Property
+
+ Public ReadOnly Property FotogramaActual() As Image
+ Get
+ If Not (_Picture Is Nothing) Then Return _Picture.Image
+ Return Nothing
+ End Get
+ End Property
+
+ Public Sub IniciarCaptura(ByVal PB As PictureBox)
+ If Me.Running Then
+ Throw New CamaraYaHaSidoInicializadaEx
+ Else
+ Try
+ _Picture = PB
+ _hWnd = capCreateCaptureWindowA(_Device, WS_VISIBLE Or WS_CHILD, 0, 0, OutputWidth, CShort(OutputHeight), PB.Handle.ToInt32, 0)
+ ConfigurarCamara()
+ Catch Ex As Exception
+ _Picture = Nothing
+ Throw Ex
+ End Try
+ End If
+ End Sub
+
+ Public Sub DetenerCaptura()
+ If Me.Running Then
+ SendMessage(_hWnd, WM_CAP_DRIVER_DISCONNECT, 0, CType(0, String)) 'Descoenctar
+ _Picture = Nothing
+ Me.Running = False
+ Else
+ Throw New CamaraNoInicializadaEx
+ End If
+ End Sub
+
+ Public Sub ReiniciarCamera()
+ If _Running Then
+ DetenerCaptura()
+ Application.DoEvents() 'Continuar Con los eventos mientras se detiene y se enciende de nuevo la camara
+ ConfigurarCamara()
+ Else
+ Throw New CamaraNoInicializadaEx
+ End If
+ End Sub
+
+ Private Sub ConfigurarCamara()
+ 'Encender camara
+ If SendMessage(_hWnd, WM_CAP_DRIVER_CONNECT, CType(_Device, Short), CType(0, String)) = 1 Then
+
+ Dim CameraFrameRate As Short = CType(1000 \ _FramesPorrSegundo, Short)
+
+ SendMessage(_hWnd, WM_CAP_SET_SCALE, 1, CType(0, String))
+ 'Le decimos el framerate, y le decimos que usaremos vista preliminar
+ SendMessage(_hWnd, WM_CAP_SET_PREVIEWRATE, CameraFrameRate, CType(0, String))
+ SendMessage(_hWnd, WM_CAP_SET_PREVIEW, 1, CType(0, String))
+ Me.Running = True
+
+ SetWindowPos(_hWnd, HWND_BOTTOM, 0, 0, _Picture.Width, _Picture.Height, SWP_NOMOVE Or SWP_NOZORDER)
+ Else
+ Me.Running = False
+ Throw New CamaraNoConfiguradaEx
+ End If
+ End Sub
+
+
+ Public Function CapturarImagen() As Image
+ Dim data As IDataObject
+ Dim bmap As Image
+
+ 'Copiar la imagen al portapapeles
+ SendMessage(_hWnd, WM_CAP_EDIT_COPY, 0, CType(0, String))
+
+ 'Tomar la imagen del portapapeles y comvertirlo a image
+ data = Clipboard.GetDataObject()
+ If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
+ bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)), Image)
+ Return bmap
+ Else
+ Return Nothing
+ End If
+ End Function
+
+ End Class
+
+#Region "Excepciones"
+
+ Public Class NoExistenCamarasEx
+ Inherits Exception
+ Public Sub New()
+ MyBase.New("No Existen camaras web instaladas en el equipo.")
+ End Sub
+ End Class
+
+ Public Class CamaraNoInicializadaEx
+ Inherits Exception
+ Public Sub New()
+ MyBase.New("La camara no ha sido inicializada")
+ End Sub
+ End Class
+ Public Class CamaraNoConfiguradaEx
+ Inherits Exception
+ Public Sub New()
+ MyBase.New("La configuracion de la camara ha fallado")
+ End Sub
+ End Class
+ Public Class CamaraYaHaSidoInicializadaEx
+ Inherits Exception
+ Public Sub New()
+ MyBase.New("La camara ya ha sido inicializada")
+ End Sub
+ End Class
+
+#End Region
+End Module

0 comments on commit 434df4d

Please sign in to comment.