how to capture a photo from my web cam ?
in [VB.NET]
|
From: AussieRules on 14 Apr 2010 21:35 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
From: zzz on 15 Apr 2010 04:26 "AussieRules" <nospam(a)nospam.com> ha scritto nel messaggio news:%23XVi2vD3KHA.5212(a)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
From: AussieRules on 15 Apr 2010 06:56 thanks for you reply and code... appreciate it... "zzz" <zzz(a)tin.it> wrote in message news:4bc6ce5b$0$1109$4fafbaef(a)reader2.news.tin.it... > > "AussieRules" <nospam(a)nospam.com> ha scritto nel messaggio > news:%23XVi2vD3KHA.5212(a)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 > >
From: Armin Zingler on 14 Apr 2010 22:03 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/Search/en-US?query=capture%20image%20from%20web%20cam&ac=8 "Video capture": http://msdn.microsoft.com/en-us/library/dd757692%28VS.85%29.aspx Especially "Still-Image Capture": http://msdn.microsoft.com/en-us/library/dd798686%28VS.85%29.aspx -- Armin
|
Pages: 1 Prev: communication between two vb apps Next: DateGridView NRE Error |