Okay, I'm creating a webcam capture program that will take pictures and record video. The picture part works perfectly but I can't get the video part to work. No matter what I try it won't save the AVI file Heres my code

OOption Explicit On

Imports System.Runtime.InteropServices

Public Class Form1

    Dim myCam = New Cam.iCam

    Dim hwdc As Long
    Dim startcap As Boolean



    'thing
    Const WM_CAP_START = &H400S
    Const WS_CHILD = &H40000000
    Const WS_VISIBLE = &H10000000

    Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
    Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11
    Const WM_CAP_EDIT_COPY = WM_CAP_START + 30
    Const WM_CAP_SEQUENCE = WM_CAP_START + 62
    Const WM_CAP_FILE_SAVEAS = WM_CAP_START + 23

    Const WM_CAP_SET_SCALE = WM_CAP_START + 53
    Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
    Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50

    Const SWP_NOMOVE = &H2S
    Const SWP_NOSIZE = 1
    Const SWP_NOZORDER = &H4S
    Const HWND_BOTTOM = 1
    Dim count As Integer = 0

    '--The capGetDriverDescription function retrieves the version 
    ' description of the capture driver--
    Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriverIndex As Short, ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, ByVal cbVer As Integer) As Boolean

    '--The capCreateCaptureWindow function creates a capture window--
    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 hWnd As Integer, ByVal nID As Integer) As Integer

    '--This function sends the specified message to a window or windows--
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal Msg As Integer, ByVal wParam As Integer, <MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Integer

    '--Sets the position of the window relative to the screen buffer--
    Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Integer, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer

    '--This function destroys the specified window--
    Declare Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean

    '--thing--
    Public 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

    '---used to identify the video source---
    Dim VideoSource As Integer
    '---used as a window handle---
    Dim hWnd As Integer

    Private Sub Form1_Load( ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        btnStartRecording.Enabled = True
        btnStopRecording.Enabled = False
        '---list all the video sources---
        ListVideoSources()
        lstVideoSources.SelectedIndex = 0
        'PreviewVideo(pbctrl)

    End Sub
    Private Sub ListVideoSources()
        Dim DriverName As String = Space(80)
        Dim DriverVersion As String = Space(80)
        For i As Integer = 0 To 9
            If capGetDriverDescriptionA(i, DriverName, 80, DriverVersion, 80) Then
                lstVideoSources.Items.Add(DriverName.Trim)
            End If
        Next
    End Sub
    '---list all the video sources---
    Private Sub lstVideoSources_SelectedIndexChanged( ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lstVideoSources.SelectedIndexChanged
        '---check which video source is selected---
        VideoSource = lstVideoSources.SelectedIndex
        '---preview the selected video source
        PreviewVideo(pbCtrl)
    End Sub
    '---preview the selected video source---
    Private Sub PreviewVideo(ByVal pbCtrl As PictureBox)
        hWnd = capCreateCaptureWindowA(VideoSource, WS_VISIBLE Or WS_CHILD, 0, 0, 0, 0, pbCtrl.Handle.ToInt32, 0)

        If SendMessage( hWnd, WM_CAP_DRIVER_CONNECT, VideoSource, 0) Then

            '---set the preview scale---
            SendMessage(hWnd, WM_CAP_SET_SCALE, True, 0)
            '---set the preview rate (ms)---
            SendMessage(hWnd, WM_CAP_SET_PREVIEWRATE, 100, 0)
            '---start previewing the image---
            SendMessage(hWnd, WM_CAP_SET_PREVIEW, True, 0)
            '---resize window to fit in PictureBox control---
            SetWindowPos(hWnd, HWND_BOTTOM, 0, 0, _
               pbCtrl.Width, pbCtrl.Height, _
               SWP_NOMOVE Or SWP_NOZORDER)
        Else
            '--error connecting to video source---
            DestroyWindow(hWnd)
        End If
    End Sub

    '---stop the preview window---
    Private Sub btnStopCamera_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStopCamera.Click
        StopPreviewWindow()
    End Sub

    '--disconnect from video source---
    Private Sub StopPreviewWindow()
        SendMessage(hWnd, WM_CAP_DRIVER_DISCONNECT, VideoSource, 0)
        DestroyWindow(hWnd)
    End Sub

    '---Start recording the video---
    Private Sub btnStartRecording_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStartRecording.Click
        btnStartRecording.Enabled = False
        btnStopRecording.Enabled = True
        '---start recording---
        SendMessage(hWnd, WM_CAP_SEQUENCE, 0, 0)
    End Sub

    '---stop recording and save it on file---
    Private Sub btnStopRecording_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStopRecording.Click
        btnStartRecording.Enabled = True
        btnStopRecording.Enabled = False
        '---save the recording to file---

        Try
            SendMessage(hWnd, WM_CAP_FILE_SAVEAS, 1, "C:\Users\Caleb\Desktop\recordedvideo.avi")
        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try
        
    End Sub


    Private Function CopyThing(ByVal src As PictureBox, ByVal rect As RectangleF) As Bitmap
        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)

        CopyThing = CType(srcBmp.Clone(), Bitmap)

        'Clean Up 
        srcPic.ReleaseHdc(HDC1)
        srcMem.ReleaseHdc(HDC2)
        srcPic.Dispose()
        srcMem.Dispose()
    End Function


    'end thing

    Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        StopPreviewWindow()
    End Sub

    'Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    'myCam.initCam(Me.PictureBox1.Handle.ToInt32)
    'End Sub

    Private Sub PictureBtn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PictureBtn.Click
        Dim src As PictureBox = pbctrl
        Dim rect As New RectangleF(0, 0, 640, 480)

        Dim image As Image = CopyThing(src, rect)

        Dim preview As New ImagePreview
        preview.ImagePic.Image = image
        preview.Show()
    End Sub



End Class

I have no idea why it won't save the video. I even used a try/catch to get an error but it didn't have an error. Any ideas?

Thanks,
Daniel

Recommended Answers

All 2 Replies

I´m doing a proyect like that.. i did that works ... but i need that stop after 30 seconds but the screen get freeze, I must click the mouse over the form to works, i need to solve this problem anyway it will work´s perfect for you. If in doubt, look for me erik_armando@hotmail.com


Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
Dim saveName As New SaveFileDialog
Dim timeValue As DateTime = TimeOfDay
saveName.FileName = "C:\" + DateString + " -" + Str(DateAndTime.Hour(timeValue)) + " -" + Str(DateAndTime.Minute(timeValue)) + " -" + Str(DateAndTime.Second(timeValue)) + ".avi"
SendMessage(hWnd, WM_CAP_FILE_SAVEAS, 0, saveName.FileName)

Me.Cursor = System.Windows.Forms.Cursors.Default
Button2.Enabled = True
Button3.Enabled = False
End Sub

You could have a look at this project.
It uses DirectX for video capture and saving.

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.