1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Vb.net camera video

Vb.net camera video

Soyez le premier à donner votre avis sur cette source.

Snippet vu 6 780 fois - Téléchargée 19 fois

Commenter

Contenu du snippet

ce programme contient un code qui permet l'affichage d'un prévisualisation de vidéo avec le vb.net 2010

Source / Exemple : 


'Module modWebcam''''''''''''''''''
Option Explicit On
Option Strict Off

Imports System
Imports System.Runtime
Imports System.Runtime.InteropServices

Module modWebcam
    Public Const WM_CAP As Short = &H400S

    Public Const WM_CAP_DRIVER_CONNECT As Integer = WM_CAP + 10
    Public Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_CAP + 11
    Public Const WM_CAP_EDIT_COPY As Integer = WM_CAP + 30

    Public Const WM_CAP_SET_PREVIEW As Integer = WM_CAP + 50
    Public Const WM_CAP_SET_PREVIEWRATE As Integer = WM_CAP + 52
    Public Const WM_CAP_SET_SCALE As Integer = WM_CAP + 53
    Public Const WS_CHILD As Integer = &H40000000
    Public Const WS_VISIBLE As Integer = &H10000000
    Public Const SWP_NOMOVE As Short = &H2S
    Public Const SWP_NOSIZE As Short = 1
    Public Const SWP_NOZORDER As Short = &H4S
    Public Const HWND_BOTTOM As Short = 1

    Public iDevice As Integer = 0 ' Current device ID 
    Public hHwnd As Integer ' Handle to preview window 

    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, _
        <MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Integer

    Public 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

    Public Declare Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean

    Public 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

    Public 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 Module
'Fin  Module modWebcam''''''''''''''''''

'Form1
Public Class Form1

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        LoadDeviceList()
    End Sub
    Private Sub LoadDeviceList()
        On Error Resume Next
        Dim strName As String = Space(100)
        Dim strVer As String = Space(100)
        Dim bReturn As Boolean
        Dim x As Integer = 0

        Do
            bReturn = capGetDriverDescriptionA(x, strName, 100, strVer, 100)
            If bReturn Then lst1.Items.Add(strName.Trim)
            x += 1
            Application.DoEvents()
        Loop Until bReturn = False

    End Sub
    'This function is used to start capture frame.

    'Open View
    Private Sub OpenPreviewWindow()
        On Error Resume Next

        Dim iHeight As Integer = pview.Height
        Dim iWidth As Integer = pview.Width

        '
        ' Open Preview window in picturebox
        '
        hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, _
            480, pview.Handle.ToInt32, 0)

        '
        ' Connect to device
        '
        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, pview.Width, pview.Height, _
                    SWP_NOMOVE Or SWP_NOZORDER)

        Else
            '
            ' Error connecting to device close window
            ' 
            DestroyWindow(hHwnd)

        End If
    End Sub
    'This function is used to close Capture Function.
    Private Sub ClosePreviewWindow()
        On Error Resume Next
        '
        ' Disconnect from device
        '
        SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, iDevice, 0)

        '
        ' close window
        '
        DestroyWindow(hHwnd)

    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        If Lst1.Items.Count = 0 Then
            MsgBox("Il n'y'a aucune caméra installé", vbCritical, "Pas de caméra")
        End If
        If Lst1.SelectedIndex < 0 Then
            MsgBox("il faut sélection une ligne dans la liste!", vbInformation, "Erreur caméra")
        Else
            OpenPreviewWindow()
        End If

    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        ClosePreviewWindow()
    End Sub
End Class

A voir également

Ajouter un commentaire

Commentaires

Signaler

c'est bon j'apprecie cet algorithme et son resultat
Signaler
Messages postés
1172
Date d'inscription
jeudi 24 mai 2007
Statut
Membre
Dernière intervention
28 septembre 2013
 1
maintenant reste à l'exploiter !
et aussi trouver mieux que le :
Dim strName As String = "" '= Space(100)
strName = strName.PadRight(100, " "c)

mais bon en attendant ça marche si une cam est connecté, donc faire la gestion des erreurs et aussi pensez à ajouter un picturebox nommé pview et un bouton sur votre form ;)
voila spa compliqué de faire les choses correctement ;) allez zou au boulot !
et essaye de nous poster un code qui scan les changements d'image pour faire une alerte en cas d'intrusion devant la webcam par exemple ;)
bonne prog et @++
Signaler
Messages postés
1172
Date d'inscription
jeudi 24 mai 2007
Statut
Membre
Dernière intervention
28 septembre 2013
 1
voila en 20min une pseudo correction ^^

Option Explicit On
Option Strict On
Imports System
Imports System.Runtime
Imports System.Runtime.InteropServices
Module modWebcam
Public Const WM_CAP As Short = &H400S
Public Const WM_CAP_DRIVER_CONNECT As Integer = WM_CAP + 10
Public Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_CAP + 11
Public Const WM_CAP_EDIT_COPY As Integer = WM_CAP + 30
Public Const WM_CAP_SET_PREVIEW As Integer = WM_CAP + 50
Public Const WM_CAP_SET_PREVIEWRATE As Integer = WM_CAP + 52
Public Const WM_CAP_SET_SCALE As Integer = WM_CAP + 53
Public Const WS_CHILD As Integer = &H40000000
Public Const WS_VISIBLE As Integer = &H10000000
Public Const SWP_NOMOVE As Short = &H2S
Public Const SWP_NOSIZE As Short = 1
Public Const SWP_NOZORDER As Short = &H4S
Public Const HWND_BOTTOM As Short = 1
Public iDevice As Integer = 0 ' Current device ID
Public hHwnd As Integer ' Handle to preview window
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, _
<MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Integer
Public 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
Public Declare Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean
Public 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
Public 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 Module
'Fin Module modWebcam''''''''''''''''''

Public Class Form1
Dim lst1 As New List(Of String)

Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
ClosePreviewWindow()
End Sub 'close device
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
LoadDeviceList()
End Sub 'load device

Private Sub LoadDeviceList()
Try
Dim strName As String = "" '= Space(100)
strName = strName.PadRight(100, " "c)
Dim strVer As String = "" '= Space(100)
strVer = strVer.PadLeft(100, " "c)
Dim bReturn As Boolean
Dim x As Short = 0 'de 0 à 9 selon msdn
Do
bReturn = capGetDriverDescriptionA(x, strName, 100, strVer, 100)
If bReturn Then lst1.Add(strName) '.Trim)
x = CShort(x + 1)
Application.DoEvents()
Loop Until bReturn = False
Catch ex As Exception
Exit Sub
End Try

End Sub ' sub pour trouver les cams intallées sur ce poste

Private Sub OpenPreviewWindow()
On Error Resume Next
Dim iHeight As Integer = pview.Height
Dim iWidth As Integer = pview.Width
'
' Open Preview window in picturebox
'
hHwnd = capCreateCaptureWindowA(CStr(iDevice), WS_VISIBLE Or WS_CHILD, 0, 0, 640, _
480, pview.Handle.ToInt32, 0)
'
' Connect to device
'
If CBool(SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0)) Then
'
'Set the preview scale
'
SendMessage(hHwnd, WM_CAP_SET_SCALE, 1, 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, 1, 0)
'
' Resize window to fit in picturebox
'
SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, pview.Width, pview.Height, _
SWP_NOMOVE Or SWP_NOZORDER)
Else
'
' Error connecting to device close window
'
DestroyWindow(hHwnd)
End If
End Sub 'This function is used to start capture frame.

Private Sub ClosePreviewWindow()
On Error Resume Next
'
' Disconnect from device
'
SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, iDevice, 0)
'
' close window
'
DestroyWindow(hHwnd)
End Sub 'This function is used to close Capture Function.

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If lst1.Count <= 0 Then
Exit Sub
Else
OpenPreviewWindow()
End If
End Sub 'lance le visionnage
End Class
Signaler
Messages postés
1172
Date d'inscription
jeudi 24 mai 2007
Statut
Membre
Dernière intervention
28 septembre 2013
 1
et mets le zip aussi ^^ on ne sais pas comment son paramétré les contrôles (taille, etc...) pour un débutant c'est inexploitable ;)
bref sinon comme le souligne Galain, un copié collé ne sert à rien sans explication !
exemple tu écris :
Dim strName As String = Space(100) pourquoi ?
parceque la fonction getdriverdescription demande une zone de 100 chars ?
dans ce cas pourquoi ne pas écrire
dim strName(100) as string ou autre, enfin tu vois le truc, suffit pas de balancer un code pompé, sans expliquer aux lecteurs comment il marche !
enfin c'est mon avis, je vais tester ce code pour voir si y'a moyen de faire mumuse avec. bonne continuation et @++
Signaler
Messages postés
1263
Date d'inscription
mardi 11 novembre 2003
Statut
Membre
Dernière intervention
24 juillet 2013
 6
Salut

On Error Resume Next : c'est du VB 6 !
tout comme Msgbox

vire l'importation de Microsoft.Visual.Basic dans les options du projet
mets Option Strict sur ON
ensuite tu feras du véritable NET
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.