roboforum.ru

/*
* Программа захватывает видео с камеры
* Для выхода используется клавиша e
*/
#include <highgui.h>
#include <stdio.h>

int main()
{
   // создаем окошко для манипуляций
   const char *window = "Тестовое окно";   
   cvNamedWindow(window);

   // буфер-кадр
   IplImage *img;
   // создаем поток для видео
   CvCapture *camera = cvCreateCameraCapture(CV_CAP_ANY);

   do {
      img = cvQueryFrame(camera);
      cvShowImage(window, img);
   } while (cvWaitKey(33) != 'e');

   cvDestroyAllWindows();
}

char *ptr;   // указатель на начало сграбленного изображения
IplImage *frame = cvCreateImage(cvSize(640, 480),IPL_DEPTH_8U, 3);   // хидер
frame->imageData = ptr;   // привязали данные

Option Explicit

Const WM_USER = 1024
Const WM_CAP_DRIVER_CONNECT = WM_USER + 10
Const WM_CAP_SET_PREVIEW = WM_USER + 50
Const WM_CAP_SET_PREVIEWRATE = WM_USER + 52
Const WM_CAP_DRIVER_DISCONNECT = WM_USER + 11
Const WM_CAP_GRAB_FRAME = WM_USER + 60
Const WM_CAP_FILE_SAVEDIB = WM_USER + 25

Private 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
Private Declare Function SendMessageString Lib "user32" Alias "SendMessageA" (ByVal HWND As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private 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
Private Declare Function capGetDriverDescription Lib "avicap32" Alias "capGetDriverDescriptionA" (ByVal wDriverIndex As Long, ByVal lpszName As String, ByVal cbName As Long, ByVal lpszVer As String, ByVal cbVer As Long) As Long

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Dim hWDC As Long
Dim STARTcap As Boolean
Dim i, j, k, i2, j2 As Integer
Dim c, f, h As Long

Private Sub Command1_Click()
hWDC = capCreateCaptureWindow("VideoCapture", 0, 0, 0, 320, 240, Picture1.HWND, 0)
  If (hWDC <> 0) Then
    SendMessage hWDC, WM_CAP_DRIVER_CONNECT, 0, 0
     STARTcap = True
     Timer1.Enabled = True
   Else
    MsgBox ("no cam found")
  End If
End Sub


Private Sub Command2_Click()
If STARTcap = True Then
Call SendMessage(hWDC, WM_CAP_DRIVER_DISCONNECT, 0, 0)
STARTcap = False
End If
End Sub

Private Sub Form_Terminate()
f = 10000
i2 = 0
j2 = 0
Picture1.ScaleMode = vbPixels
Timer1.Enabled = False
If STARTcap = True Then
Call SendMessage(hWDC, WM_CAP_DRIVER_DISCONNECT, 0, 0)
STARTcap = False
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Timer1.Enabled = False
If STARTcap = True Then
Call SendMessage(hWDC, WM_CAP_DRIVER_DISCONNECT, 0, 0)
STARTcap = False
End If
End Sub

Private Sub Timer1_Timer()
On Error GoTo 1
    SendMessage hWDC, WM_CAP_GRAB_FRAME, 0, 0
    SendMessageString hWDC, WM_CAP_FILE_SAVEDIB, 0, App.Path & "\VIDEO1.BMP"
    Picture1.Picture = LoadPicture(App.Path & "\VIDEO1.BMP")

    DoEvents
1:
End Sub