Hi,

I have a web cam connected to the computer and was wondering if there is
away to take a photo using the camera via vb.net code ?

Is this able to be done ?

Thanks

Am 15.04.2010 03:35, schrieb AussieRules:
> Hi,
>
> I have a web cam connected to the computer and was wondering if there is
> away to take a photo using the camera via vb.net code ?
>
> Is this able to be done ?

Maybe something helpful here:
http://social.msdn.microsoft.com/Sea...web%20cam&ac=8

"Video capture":
http://msdn.microsoft.com/en-us/libr...8VS.85%29.aspx

Especially "Still-Image Capture":
http://msdn.microsoft.com/en-us/libr...8VS.85%29.aspx

--
Armin

thanks for you reply and code...

appreciate it...

"zzz" <(E-Mail Removed)> wrote in message
news:4bc6ce5b$0$1109$(E-Mail Removed)...
>
> "AussieRules" <(E-Mail Removed)> ha scritto nel messaggio
> news:%(E-Mail Removed)...
>> Hi,
>>
>> I have a web cam connected to the computer and was wondering if there is
>> away to take a photo using the camera via vb.net code ?
>>
>> Is this able to be done ?
>>
>> Thanks
>>
>
> Create a user control containing a picturebox called picCapture with dock
> property=filled
> then have a look to this dirty code
> I think it will help you
>
>
>
> Imports System.Runtime.InteropServices
> Imports System.Windows.Forms
> Imports System.Drawing
>
> <Drawing.ToolboxBitmap(GetType(WebcamControl), "ico6823.ico")> _
> Public Class WebcamControl
>
> #Region "dichiarazioni"
> 'dichiarazione api di windows
>
> 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
> Const WM_CAP_SET_VIDEOFORMAT As Integer = &H42DS
>
>
> Public Structure RGBQUAD
> Dim rgbBlue As Byte
> Dim rgbGreen As Byte
> Dim rgbRed As Byte
> Dim rgbReserved As Byte
> End Structure
>
>
> Public Structure BITMAPINFOHEADER
> Dim biSize As Integer
> Dim biWidth As Integer
> Dim biHeight As Integer
> Dim biPlanes As Short
> Dim biBitCount As Short
> Dim biCompression As Integer
> Dim biSizeImage As Integer
> Dim biXPelsPerMeter As Integer
> Dim biYPelsPerMeter As Integer
> Dim biClrUsed As Integer
> Dim biClrImportant As Integer
> End Structure
>
>
>
> <StructLayout(LayoutKind.Sequential)> _
> Public Structure BITMAPINFO
> <MarshalAs(UnmanagedType.Struct, SizeConst:=40)> _
> Public bmiHeader As BITMAPINFOHEADER
> <MarshalAs(UnmanagedType.ByValArray, SizeConst:=1024)> _
> Public bmiColors As Int32()
> End Structure
>
>
>
>
> Declare Function SendMessageAsBitMap Lib "user32" Alias "SendMessageA"
> (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer,
> ByRef lParam As BITMAPINFO) As Integer
> Private bmp As BITMAPINFO
>
> ''' <summary>
> ''' The capSetVideoFormat API is used to indicate to the webcam the
> format
> ''' of image to be returned. Many cameras do not support all ranges of
> bitmap
> ''' formats, however, 24 bit colour 320 x 240 and 640 x 480 are quite
> common.
> ''' </summary>
> ''' <param name="hCapWnd"></param>
> ''' <param name="BmpFormat"></param>
> ''' <param name="CapFormatSize"></param>
> ''' <returns></returns>
> ''' <remarks></remarks>
> Function capSetVideoFormat(ByVal hCapWnd As Integer, ByRef BmpFormat _
> As BITMAPINFO, ByVal CapFormatSize As Integer) As Boolean
> Return SendMessageAsBitMap(hCapWnd, _
> WM_CAP_SET_VIDEOFORMAT, CapFormatSize, BmpFormat)
> End Function
>
>
> Dim iDevice As Integer = 0 ' Current device ID
> Dim hHwnd As Integer ' Handle to preview window
>
> Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
> (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As
> Integer, _
> ByVal lParam As Object) As Integer
>
> Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
> (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As
> Integer, _
> ByRef bitmapinfo As BITMAPINFO) 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
>
> 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
>
> #End Region
>
> Dim lstDevices As New ArrayList
>
> Private _x As Integer
> Private _y As Integer
> Private _hwnd As Integer
> 'dice se il controllo è stato inizializazzato per la ricerca dei driver
> di acquisizione
> 'Private was_initialized As Boolean
> 'dice se il controllo sta attualmente in fase di acquisizione
> Private _mostra_scelta_webcam As Boolean
> Private _cam_started As Boolean
> Public is_zoomed As Boolean
> Private _is_plugged As Boolean
> 'Private _mostra_scelta_webcam As Boolean
> 'dice se il controllo è stato inizializazzato per la ricerca dei driver
> di acquisizione
> Private was_initialized As Boolean
> 'dice se il controllo sta attualmente in fase di acquisizione
> 'Private _cam_started As Boolean
> ' Public is_zoomed As Boolean
>
>
> Public ReadOnly Property Is_plugged() As Boolean
> Get
> Return _is_plugged
> End Get
> End Property
>
> Public ReadOnly Property cam_started() As Boolean
> Get
> Return _cam_started
> End Get
> End Property
>
> Public Property mostra_scelta_webcam() As Boolean
> Get
> Return _mostra_scelta_webcam
> End Get
> Set(ByVal value As Boolean)
> _mostra_scelta_webcam = value
> End Set
>
> End Property
>
> Public ReadOnly Property current_hwnd() As Integer
> Get
> current_hwnd = _hwnd
> End Get
> End Property
>
> Public Event clicked()
>
>
> Public ReadOnly Property GetDevices() As ArrayList
> Get
> GetDevices = lstDevices
> End Get
> End Property
>
> Public Property Setta_IdPeriferica() As Integer
> Get
> Setta_IdPeriferica = iDevice
> End Get
> Set(ByVal value As Integer)
> If value < 0 Or value > lstDevices.Count - 1 Then
> 'MsgBox("Id non valido", MsgBoxStyle.Critical)
> Exit Property
> Else
> iDevice = value
> End If
>
> End Set
> End Property
>
> Public Function Inizializza() As Boolean
>
> picCapture.SizeMode = PictureBoxSizeMode.StretchImage
> LoadDeviceList()
>
> If lstDevices.Count > 0 Then
> Return True
> Else
> Return False
> End If
> End Function
>
> Private Sub LoadDeviceList()
> Dim strName As String = Space(100)
> Dim strVer As String = Space(100)
> Dim bReturn As Boolean
> Dim x As Integer = 0
>
> ' Load name of all avialable devices into the lstDevices
> Do
> ' Get Driver name and version
> bReturn = capGetDriverDescriptionA(x, strName, 100, strVer,
> 100)
> '
> ' If there was a device add device name to the list
> '
> If bReturn Then lstDevices.Add(strName.Trim)
> x += 1
> Loop Until bReturn = False
>
> If lstDevices.Count = 1 Then
> Me.Setta_IdPeriferica = 0
> End If
> End Sub
>
> Public Function Start_cam() As Boolean
> 'If Me._can_acquire = False Then
> 'MsgBox("nessun device connesso", MsgBoxStyle.Critical)
> 'Exit Function
> 'End If
>
>
>
>
> If Me.was_initialized = False Then
> 'allora va inizializzato.
> 'se non riesce ad inizializzare la webcam allora va a false
> If Me.Inizializza = False Then Return False
> Me.was_initialized = True
> End If
> _cam_started = True
>
>
>
> Dim tentativi_connessione = 0
> Cursor.Current = Cursors.WaitCursor
> While True
> If OpenPreviewWindow() = False Then
> tentativi_connessione += 1
> Threading.Thread.Sleep(400)
> If tentativi_connessione > 27 Then Exit While
> Else
> Exit While
> End If
> End While
>
> Cursor.Current = Cursors.Arrow
>
> If Me.Is_plugged = False Then
> Return False
> Else
> Return True
> End If
>
> End Function
>
> Public Sub Stop_cam()
> ClosePreviewWindow()
> _cam_started = False
> End Sub
>
>
> Public Function get_frame() As Image
> Dim data As IDataObject
> Dim bmap As Image
> Try
> '
> ' Copy image to clipboard
> '
> SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)
> Application.DoEvents()
> '
> ' Get image from clipboard and convert it to a bitmap
> '
> data = Clipboard.GetDataObject()
> If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
> bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)),
> Image)
> picCapture.Image = bmap
> ' ClosePreviewWindow()
> Return bmap
> Else
> MsgBox("2° tentativo di acquisizione")
> SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)
> data = Clipboard.GetDataObject()
> bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)),
> Image)
> picCapture.Image = bmap
> End If
>
> Catch ex As Exception
> MsgBox("-" & ex.Message)
> Return Nothing
> End Try
>
> Return Nothing
> End Function
>
>
> Public Sub salva_frame(ByVal file As String)
>
> Dim data As IDataObject
> Dim bmap As Image
> Try
> ' Copy image to clipboard
> '
> SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)
> '
> ' Get image from clipboard and convert it to a bitmap
> '
> data = Clipboard.GetDataObject()
> If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
> bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)),
> Image)
> picCapture.Image = bmap
> ' ClosePreviewWindow()
>
> bmap.Save(file, Imaging.ImageFormat.Jpeg)
> End If
> Catch ex As Exception
> MsgBox("-" & ex.Message)
>
> End Try
> End Sub
>
>
>
> Public Sub salva_frame_osd(ByVal file As String, ByVal text As String)
>
> Dim data As IDataObject
> Dim bmap As Image
> Dim _font = New Font(FontFamily.GenericSansSerif, _
> 10.0F, FontStyle.Bold)
> Try
> '
> ' Copy image to clipboard
> '
> SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)
> '
> ' Get image from clipboard and convert it to a bitmap
> '
> data = Clipboard.GetDataObject()
> If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
> bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)),
> Image)
> picCapture.Image = bmap
> '-----------------------------------
> 'Dim bm = New Bitmap(PictureBox10.Image)
> Dim gr As Graphics = Graphics.FromImage(bmap)
> 'gr.DrawLine(Pens.Blue, p0, p1)
> gr.FillRectangle(Brushes.Gray, 0, 460, 640, 20)
> gr.DrawString(text, _font, Brushes.Aqua, 5, 460)
> 'gr.DrawRectangle(Pens.Black, 0, 460, 640, 20)
> '----------------
> bmap.Save(file, Imaging.ImageFormat.Jpeg)
> End If
> Catch ex As Exception
> MsgBox("-" & ex.Message)
>
> End Try
> End Sub
>
>
> Public Sub setta_dimensioni(ByVal x As Integer, ByVal y As Integer)
> ' Dim bmi As New BITMAPINFO
>
> 'Dim myhand As IntPtr = CType(_hwnd, IntPtr)
> 'With bmi.bmiHeader
> ' .biSize = Len(bmi.bmiHeader)
> ' .biPlanes = 1
> ' .biBitCount = 24
> ' .biWidth = x
> ' .biHeight = y
> ' .biSizeImage = x * y * 3
> ' End With
> _x = x
> _y = y
>
> 'Dim b = System.Runtime.InteropServices.Marshal.SizeOf(bmi)
> 'SendMessage(myhand, 1069, b, bmi)
>
> ' Width = bmi.bmiHeader.biWidth
> ' Height = bmi.bmiHeader.biHeight
> 'SendMessage(myhand, WM_CAP_SET_VIDEOFORMAT, a, bmi)
> 'SendMessage(myhand, WM_CAP_SET_VIDEOFORMAT, 0, 0)
> End Sub
>
> Private Function OpenPreviewWindow() As Boolean
> Dim iHeight As Integer = picCapture.Height
> Dim iWidth As Integer = picCapture.Width
>
> '
> ' Open Preview window in picturebox
> '
> If _x <> 0 Then
>
>
> hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or
> WS_CHILD, 0, 0, _x, _
> _y, picCapture.Handle.ToInt32, 0)
>
> Else
> hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or
> WS_CHILD, 0, 0, 640, _
> 480, picCapture.Handle.ToInt32, 0)
>
> End If
> '
> ' Connect to device
> '
> _hwnd = hHwnd
>
> If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0) Then
> '
> 'Set the preview scale
> '
> SendMessage(hHwnd, WM_CAP_SET_SCALE, True, 0)
> '
> 'Set the preview rate in milliseconds
> '
> SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0)
> '
> 'Start previewing the image from the camera
> '
> SendMessage(hHwnd, WM_CAP_SET_PREVIEW, True, 0)
> ' Resize window to fit in picturebox
> '
> SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, picCapture.Width,
> picCapture.Height, SWP_NOMOVE Or SWP_NOZORDER)
> ' SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, 640, 480, SWP_NOMOVE
> Or SWP_NOZORDER)
> If _mostra_scelta_webcam = True Then SendMessage(hHwnd, 1066,
> 0, 0)
> _is_plugged = True
> Return True
> Else
> ' Error connecting to device close window
> DestroyWindow(hHwnd)
> End If
> End Function
>
> Private Sub ClosePreviewWindow()
> '
> ' Disconnect from device
> '
> SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, iDevice, 0)
> ' close window
> DestroyWindow(hHwnd)
> End Sub
>
> Public Sub New()
>
> ' Chiamata richiesta da Progettazione Windows Form.
> InitializeComponent()
> Me.was_initialized = False
> _cam_started = False
> is_zoomed = False
> ' Aggiungere le eventuali istruzioni di inizializzazione dopo la
> chiamata a InitializeComponent().
>
> End Sub
>
>
>
> Public Sub zoom()
> ClosePreviewWindow()
>
> If is_zoomed = False Then
> 'allora zooma:
> Me.Left -= Me.Width
> Me.Width = Me.Width * 2
> Me.Height = Me.Height * 2
> is_zoomed = True
> Else
> Me.Width = Me.Width \ 2
> Me.Left = Me.Left + Me.Width
> Me.Height = Me.Height \ 2
> is_zoomed = False
> End If
> OpenPreviewWindow()
> End Sub
>
> Public Sub nozoom()
> If is_zoomed = True Then
> zoom()
> End If
> End Sub
>
>
> End Class
>
>