Accessing WebCam in Visual Basic 6

Introduction

This is a simple program and can be use to access webcam from the visual basic 6.

This program checks whether webcam is available or not. If not available simple gives

a message otherwise capture from the webcam and displays in picture box.

This program has 3 diffrent functionality.

1. Capture from the webcam
2. Close the webcam
3. Format the video

Source Code

Collapse

'This program check whether webcam is available or not
    
' if available then capture and displays in picture box
    

    
'Created by Dixanta Bahadur Shrestha
    
'Created Date: 12-March-2006
    

    
'Programmer does not garuntees if  not functions well
    

    
Global Const ws_child As Long = &H40000000
    
Global 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
    
Global 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
    

    

    

    

    
Dim hwdc As Long
    
Dim startcap As Boolean
    
Private Sub cmdCapture_Click()
    
Dim temp As Long
    

    
  hwdc = capCreateCaptureWindow("Dixanta Vision System", 
    
      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 cmdVideoFormat_Click()
    
 Dim temp As Long
    
 If startcap = True Then
    
  temp = SendMessage(hwdc, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
    
End If
    
End Sub
    

    

Feel free to contact me