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