Capture video from webcam and displays in picture box

[debasisdas]

This program checks if webcam is available, if available then capture video and displays in picture box.

Add this code to the general module (.BAS file)
----------------------------------------------------------------------

Public Const ws_child As Long = &H40000000
Public Const ws_visible As Long = &H10000000
 
Global Const WM_USER = 1024
Global Const wm_cap_driver_connect = WM_USER + 10
Global Const wm_cap_set_preview = WM_USER + 50
Global Const WM_CAP_SET_PREVIEWRATE = WM_USER + 52
Global Const WM_CAP_DRIVER_DISCONNECT As Long = WM_USER + 11
Public Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_USER + 41
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal a As String, ByVal b As Long, ByVal c As Integer, ByVal d As Integer, ByVal e As Integer, ByVal f As Integer, ByVal g As Long, ByVal h As Integer) As Long

Add 4 command buttons and a picture box to the form
Add the following code to click en\vent of the respective buttons.

'General Declaration
Dim hwdc As Long
Dim startcap As Boolean
 
Private Sub cmdCapture_Click()
Dim temp As Long
 
  hwdc = capCreateCaptureWindow("Debasis Das", ws_child Or ws_visible, 0, 0, 320, 240, Picture1.hWnd, 0)
  If (hwdc <> 0) Then
    temp = SendMessage(hwdc, wm_cap_driver_connect, 0, 0)
    temp = SendMessage(hwdc, wm_cap_set_preview, 1, 0)
    temp = SendMessage(hwdc, WM_CAP_SET_PREVIEWRATE, 30, 0)
    startcap = True
    Else
    MsgBox ("No Webcam found")
  End If
End Sub
 
Private Sub cmdClose_Click()
Dim temp As Long
If startcap = True Then
temp = SendMessage(hwdc, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
startcap = False
End If
End Sub
 
Private Sub cmdexit_Click()
Unload Me
End Sub
 
Private Sub cmdVideoFormat_Click()
 Dim temp As Long
 If startcap = True Then
  temp = SendMessage(hwdc, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
End If
End Sub
 

To achieve this two API function are used.

1.capCreateCaptureWindow
2.SendMessage

Please find the details of the functions for more info .

[Charles S]

I tried your Video Capture API/Program and it worked great...sort of. The first time I ran the code it worked fine. I exited the program and restarted it. Now I get nothing but a black picturebox and none of the other buttons work (except the EXIT Button). I am using VB 6 with Windows 7 (64). I'm lost. What is the problem? I only have one webcam attached to the computer.

If I restart my computer, this code works great the first time. Seems like something is not being reset when I exit the capture.

One other note..When I try to excute the code the second time (without a computer reboot) a "Video Source" box appears. Since I only have one webcam attached there is only one choice available. I press the "OK" button and the get the problem stated above.

Thanks,

Charles

[tuxalot]

Can this be modified to work in Access with VBA?