Access web cam with multiple web cams



Thanks to some prior help i have gotten some code that i found on the net
for accessing a web cam to view my web cam and save images. Currently im
having an issue trying to figure out how to pull up a "Select a device"
window so my code will stop accessing my TV tuner card and start using my web
cam or letting me choose. Originally i would be given the option to check but
it seems after i chose the ati card it wont stop displaying that one. Im
currently listing the available drivers in a listbox but both my webcam and
tuner seem to use the same driver
Microsoft WDM Image Capture (Win32)
Im wondering if there is a way to specify the device beyond the driver or if
there is a way to force the prompt on the driver description saying choose
the device for this driver or something like it did the first time. (btw im
remoted in and the ati wont even launch b/c of a 32 bit pixel limitation but
this code still plays it ??)

here's the code for the whole class. I can post some of the interface code
if needed. Thanks in advance for any help or direction i can get

Option Explicit On
Option Strict On

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 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

Public iDevice As String
Private hHwnd As Integer
Private lwndC As Integer

Public iRunning As Boolean

Public CamFrameRate As Integer = 30
Public OutputHeight As Integer = 480
Public OutputWidth As Integer = 600

Public Sub resetCam()
'resets the camera after setting change
If iRunning Then

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

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 Function ListVideoSources() As String
Dim DriverName As String = Space(80)
Dim DriverVersion As String = Space(80)
Dim strDriver As String = ""
For i As Integer = 0 To 9
If capGetDriverDescriptionA(CShort(i), DriverName, 80,
DriverVersion, 80) Then
If i > 0 Then
strDriver &= "," & DriverName.Trim
strDriver = DriverName.Trim
End If
End If
Return strDriver
End Function
Public Sub setFrameRate(ByVal iRate As Long)
'sets the frame rate of the camera
CamFrameRate = CInt(1000 / iRate)


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
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
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
MessageBox.Show("Camera Is Not Running!")
End If
End Function

Public Function FPS() As Integer
Return CInt(1000 / (CamFrameRate))
End Function

End Class


Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question