"zzz" <z**@tin.it> wrote in message
news:4bc6ce5b$0$1109$4fafbaef@reader2.news.tin.it...
>
> "AussieRules" <nospam@nospam.com> ha scritto nel messaggio
> news:%23XVi2vD3KHA.5212@TK2MSFTNGP04.phx.gbl...
>> 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
>
>