codice:
Imports System
Imports System.Threading
Module Module1
#Region "Funzioni"
'--funzione per l'elaborazione dei pixel in una immagine--
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
'--dichiariamo la funzione utile al get di periferiche HW--
Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriverIndex As Short, ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, ByVal cbVer As Integer) As Boolean
'--Funzione per la cattura dell'immagine--
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 hWnd As Integer, ByVal nID As Integer) As Integer
'--funzione di invio di messaggi da window a windows--
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Object) As Integer
'--settiamo la posizione relativa della finistra--
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
'--distruggiamo la nostra finestra--
Declare Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean
#End Region
#Region "Constanti"
'--Dichiarazioni delle costanti--
Const WM_CAP_START = &H400S
Const WS_CHILD = &H40000000
Const WS_VISIBLE = &H10000000
Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11
Const WM_CAP_EDIT_COPY = WM_CAP_START + 30
Const WM_CAP_SEQUENCE = WM_CAP_START + 62
Const WM_CAP_FILE_SAVEAS = WM_CAP_START + 23
Const WM_CAP_SET_SCALE = WM_CAP_START + 53
Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50
Const SWP_NOMOVE = &H2S
Const SWP_NOSIZE = 1
Const SWP_NOZORDER = &H4S
Const HWND_BOTTOM = 1
#End Region
#Region "Variabili"
'--dichiarazione delle variabili
Dim VideoSource As Integer
Dim hWnd As Integer
'Variabili per l'uso della picturebox dalla webcam
Public HandlePictureBox1 As Int32
Public ImgWidth, ImgHeight As Integer
#End Region
Public Sub GetSorgentiHw(ByVal Listbox As ListBox)
Try
Dim NomeDriver As String = Space(80)
Dim VersioneDriver As String = Space(80)
For i As Integer = 0 To 9
If capGetDriverDescriptionA(i, NomeDriver, 80, VersioneDriver, 80) Then
Listbox.Items.Add(NomeDriver.Trim)
End If
Next
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "Errore " & Err.Number)
End Try
End Sub
Public Sub InterrompiPreview()
Try
SendMessage(hWnd, WM_CAP_DRIVER_DISCONNECT, VideoSource, 0)
DestroyWindow(hWnd)
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "Errore " & Err.Number)
End Try
End Sub
Public Sub VideoPreview()
Try
hWnd = capCreateCaptureWindowA(VideoSource, WS_VISIBLE Or WS_CHILD, 0, 0, 0, 0, HandlePictureBox1, 0)
If SendMessage(hWnd, WM_CAP_DRIVER_CONNECT, VideoSource, 0) Then
'settiamo la scala
SendMessage(hWnd, WM_CAP_SET_SCALE, True, 0)
'settiamo il rate in millisecondi
SendMessage(hWnd, WM_CAP_SET_PREVIEWRATE, 30, 0)
'inizializziamo il preview di immagine
SendMessage(hWnd, WM_CAP_SET_PREVIEW, True, 0)
'eseguiamo il resize nella nostra picture box
SetWindowPos(hWnd, HWND_BOTTOM, 0, 0, ImgWidth, ImgHeight, SWP_NOMOVE Or SWP_NOZORDER)
Else
'erore nella connessione
DestroyWindow(hWnd)
End If
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "Errore " & Err.Number)
End Try
End Sub
Public Sub CatturaImg1()
Try
Dim data As IDataObject
Dim bmap As Image
SendMessage(hWnd, WM_CAP_EDIT_COPY, 0, 0)
data = Clipboard.GetDataObject()
If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)), Image)
Form1.PictureBox2.Image = bmap
End If
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "Errore " & Err.Number)
End Try
End Sub
Public Sub CatturaImg2()
Try
Dim data As IDataObject
Dim bmap As Image
SendMessage(hWnd, WM_CAP_EDIT_COPY, 0, 0)
data = Clipboard.GetDataObject()
If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)), Image)
Form1.PictureBox3.Image = bmap
End If
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "Errore " & Err.Number)
End Try
End Sub
Public Sub StartRecording()
Try
'---start recording---
SendMessage(hWnd, WM_CAP_SEQUENCE, 0, 0)
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "Errore " & Err.Number)
End Try
End Sub
Public Sub StopRecording()
Try
Dim OFD As New SaveFileDialog
OFD.ShowDialog()
If OFD.FileName <> "" Then
SendMessage(hWnd, WM_CAP_FILE_SAVEAS, 0, OFD.FileName & ".avi")
End If
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "Errore " & Err.Number)
End Try
End Sub
Public Sub AttivaCam()
Try
InterrompiPreview()
VideoSource = 0 'Form1.ListBox1.SelectedIndex
VideoPreview()
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "Errore " & Err.Number)
End Try
End Sub
End Module
Il codice appena sopra serve per l'utilizzo della webcam mentre il codice sotto per l'avvio delle operazione di avvio della webcam