controlling Microsoft LifeCam Cinema WEBCAM (ZOOM feature)

Learner VBNET

Member
Joined
Aug 18, 2010
Messages
14
Programming Experience
Beginner
Hi

I have a Microsoft LifeCam Cinema Webcam. I have written a simple application thats STARTS the video capture, STOPS the video capture, captures a STILL image and CLEARS the still image on one form using TWO picture boxes....one to hold the STILL image and the other to show the VIDEO from the Webcam.

I am using the VFW(Video for Windows) API to interface to the Webcam and everything in the application is working as intended with NO PROBLEMS. I use No DirectX, No ActiveX/COM, No Intermediary file, just live video stream.

I do however wish to control the ZOOM feature of the camera using the VFW API.(increase and decrease)

Can anyone please assist me in this regard by illustrating how I can do this in code....only the ZOOM feature as the other functionality is working correctly.

Much Appreciated.
 
Last edited:
My Code is as follows :

' Base Module

VB.NET:
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


' Windows Form
VB.NET:
Option Explicit On
Option Strict On

Public Class TakePhotograph
    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

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        If myCam.iRunning Then
        Else
            myCam.initCam(Me.picOutput.Handle.ToInt32)
        End If
    End Sub

    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
        If myCam.iRunning Then
            myCam.resetCam()
        End If
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        picImage.Image = Nothing
    End Sub
End Class


And the Form is as follows (copy of form via attachment) :

Photograph App.jpg



Many Thanks.
 
Last edited by a moderator:
Back
Top