471,120 Members | 1,454 Online
Bytes | Software Development & Data Engineering Community
Post +

Home Posts Topics Members FAQ

Join Bytes and contribute your articles to a community of 471,120 developers and data experts.

Capture video from webcam and displays in picture box

8,127 Expert 4TB
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)
Expand|Select|Wrap|Line Numbers
  1. Public Const ws_child As Long = &H40000000
  2. Public Const ws_visible As Long = &H10000000
  4. Global Const WM_USER = 1024
  5. Global Const wm_cap_driver_connect = WM_USER + 10
  6. Global Const wm_cap_set_preview = WM_USER + 50
  7. Global Const WM_CAP_SET_PREVIEWRATE = WM_USER + 52
  8. Global Const WM_CAP_DRIVER_DISCONNECT As Long = WM_USER + 11
  9. Public Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_USER + 41
  10. 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
  11. 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.

Expand|Select|Wrap|Line Numbers
  1. 'General Declaration
  2. Dim hwdc As Long
  3. Dim startcap As Boolean
  5. Private Sub cmdCapture_Click()
  6. Dim temp As Long
  8.   hwdc = capCreateCaptureWindow("Debasis Das", ws_child Or ws_visible, 0, 0, 320, 240, Picture1.hWnd, 0)
  9.   If (hwdc <> 0) Then
  10.     temp = SendMessage(hwdc, wm_cap_driver_connect, 0, 0)
  11.     temp = SendMessage(hwdc, wm_cap_set_preview, 1, 0)
  12.     temp = SendMessage(hwdc, WM_CAP_SET_PREVIEWRATE, 30, 0)
  13.     startcap = True
  14.     Else
  15.     MsgBox ("No Webcam found")
  16.   End If
  17. End Sub
  19. Private Sub cmdClose_Click()
  20. Dim temp As Long
  21. If startcap = True Then
  22. temp = SendMessage(hwdc, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
  23. startcap = False
  24. End If
  25. End Sub
  27. Private Sub cmdexit_Click()
  28. Unload Me
  29. End Sub
  31. Private Sub cmdVideoFormat_Click()
  32.  Dim temp As Long
  33.  If startcap = True Then
  34.   temp = SendMessage(hwdc, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
  35. End If
  36. End Sub
To achieve this two API function are used.


Please find the details of the functions for more info .
Oct 9 '07 #1
2 30457
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.


Jul 22 '10 #2
200 100+
Can this be modified to work in Access with VBA?
Dec 31 '11 #3

Post your reply

Sign in to post your reply or Sign up for a free account.

Similar topics

reply views Thread by Kanaiya | last post: by
1 post views Thread by kantrishi | last post: by
reply views Thread by Tsunami | last post: by
2 posts views Thread by vmorikawa | last post: by
9 posts views Thread by aljosa | last post: by
2 posts views Thread by Joseph Chase | last post: by

By using Bytes.com and it's services, you agree to our Privacy Policy and Terms of Use.

To disable or enable advertisements and analytics tracking please visit the manage ads & tracking page.