Pilotage d'une webcam "MS lifecam cimema"

**colorid** · 03/04/2011, 15h20

Bonjour,

Je suis totalement nouveau en VB. Je cherche à piloter une WebCam "MS LifeCam Cinema". J'ai trouvé un code source VB sur le Net, j'ai téléchargé VB express 2010 et suis arrivé à compiler correctement le source suivant qui accompagme une form1 (voir code après celui du module1)

Mon problème : Comment initialiaser l'objet iCam pour qu'il reconnaisse la webcam ? actuellement si je clique sur le bouton4 j'obtient le message "Camera Is Not Running !" avec la "MS LifeCam Cinema" en fonctionnement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
Option Explicit On
Option Strict On
Imports System.Runtime.InteropServices
Imports System.Windows.Forms
Imports System.Runtime.InteropServices.ComTypes
Module Module1
    Public Class iCam
#Region "Api/constants"
 
        Private Const WS_CHILD As Integer = &H40000000
        Private Const WS_VISIBLE As Integer = &H10000000
        Private Const SWP_NOMOVE As Short = &H2S
        Private Const SWP_NOZORDER As Short = &H4S
        Private Const WM_USER As Short = &H400S
        Private Const WM_CAP_DRIVER_CONNECT As Integer = WM_USER + 10
        Private Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_USER + 11
        Private Const WM_CAP_SET_VIDEOFORMAT As Integer = WM_USER + 45
        Private Const WM_CAP_SET_PREVIEW As Integer = WM_USER + 50
        Private Const WM_CAP_SET_PREVIEWRATE As Integer = WM_USER + 52
        Private Const WM_CAP_GET_FRAME As Long = 1084
        Private Const WM_CAP_COPY As Long = 1054
        Private Const WM_CAP_START As Long = WM_USER
        Private Const WM_CAP_STOP As Long = (WM_CAP_START + 68)
        Private Const WM_CAP_SEQUENCE As Long = (WM_CAP_START + 62)
        Private Const WM_CAP_SET_SEQUENCE_SETUP As Long = (WM_CAP_START + 64)
        Private Const WM_CAP_FILE_SET_CAPTURE_FILEA As Long = (WM_CAP_START + 20)
 
        Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Short, ByVal lParam As String) As Integer
        Private 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
        Private 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
        Private Declare Function BitBlt Lib "GDI32.DLL" (ByVal hdcDest As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As Int32) As Boolean
 
#End Region
 
        Private iDevice As String
        Private hHwnd As Integer
        Private lwndC As Integer
 
        Public iRunning As Boolean
 
        Private CamFrameRate As Integer = 15
        Private OutputHeight As Integer = 240
        Private OutputWidth As Integer = 360
 
        Public Sub resetCam()
            'resets the camera after setting change
            If iRunning Then
                closeCam()
                Application.DoEvents()
 
                If setCam() = False Then
                    MessageBox.Show("Errror Setting/Re-Setting Camera")
                End If
            End If
 
        End Sub
 
        Public Sub initCam(ByVal parentH As Integer)
            'Gets the handle and initiates camera setup
            If Me.iRunning = True Then
                MessageBox.Show("Camera Is Already Running")
                Exit Sub
            Else
 
                hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, OutputWidth, CShort(OutputHeight), parentH, 0)
 
 
                If setCam() = False Then
                    MessageBox.Show("Error setting Up Camera")
                End If
            End If
        End Sub
 
        Public Sub setFrameRate(ByVal iRate As Long)
            'sets the frame rate of the camera
            CamFrameRate = CInt(1000 / iRate)
 
            resetCam()
 
        End Sub
 
        Private Function setCam() As Boolean
            'Sets all the camera up
            If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, CShort(iDevice), CType(0, String)) = 1 Then
                SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, CShort(CamFrameRate), CType(0, String))
                SendMessage(hHwnd, WM_CAP_SET_PREVIEW, 1, CType(0, String))
                Me.iRunning = True
                Return True
            Else
                Me.iRunning = False
                Return False
            End If
        End Function
 
        Public Function closeCam() As Boolean
            'Closes the camera
            If Me.iRunning Then
                closeCam = CBool(SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, 0, CType(0, String)))
                Me.iRunning = False
                Return True
            Else
                Return False
            End If
        End Function
 
        Public Function copyFrame(ByVal src As PictureBox, ByVal rect As RectangleF) As Bitmap
            If iRunning Then
                Dim srcPic As Graphics = src.CreateGraphics
                Dim srcBmp As New Bitmap(src.Width, src.Height, srcPic)
                Dim srcMem As Graphics = Graphics.FromImage(srcBmp)
 
 
                Dim HDC1 As IntPtr = srcPic.GetHdc
                Dim HDC2 As IntPtr = srcMem.GetHdc
 
                BitBlt(HDC2, 0, 0, CInt(rect.Width), _
                  CInt(rect.Height), HDC1, CInt(rect.X), CInt(rect.Y), 13369376)
 
                copyFrame = CType(srcBmp.Clone(), Bitmap)
 
                'Clean Up 
                srcPic.ReleaseHdc(HDC1)
                srcMem.ReleaseHdc(HDC2)
                srcPic.Dispose()
                srcMem.Dispose()
            Else
                MessageBox.Show("Camera Is Not Running!")
                copyFrame = Nothing
            End If
        End Function
 
        Public Function FPS() As Integer
            Return CInt(1000 / (CamFrameRate))
        End Function
 
    End Class
 
End Module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Option Explicit On
Option Strict On
 
Public Class Form1
    Inherits System.Windows.Forms.Form
 
#Region " Windows Form Designer generated code "
 
    Public Sub New()
        MyBase.New()
 
        'This call is required by the Windows Form Designer.
        InitializeComponent()
 
        'Add any initialization after the InitializeComponent() call
 
    End Sub
 
 
 
#End Region
 
    Private myCam As iCam
    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        If myCam.iRunning Then
 
            Me.picImage.Image = myCam.copyFrame(Me.picOutput, New RectangleF(0, 0, _
                            Me.picOutput.Width, Me.picOutput.Height))
            Me.Show()
        Else
            MessageBox.Show("Camera Is Not Running!")
        End If
    End Sub
 
    Private Sub TakePhotograph_Leave(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Leave
        If myCam.iRunning Then
            myCam.closeCam()
            Application.DoEvents()
            myCam = Nothing
        End If
    End Sub
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.picOutput.SizeMode = PictureBoxSizeMode.StretchImage
        myCam = New iCam
    End Sub
 
    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        If myCam.iRunning Then
            myCam.closeCam()
            Application.DoEvents()
            myCam = Nothing
            Me.picOutput.SizeMode = PictureBoxSizeMode.StretchImage
            myCam = New iCam
        End If
    End Sub

Merci pour le coup de main