Работа с веб камерой

[Legeardo]

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls,ShellAPI;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    Timer1: TTimer;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
const WM_CAP_START = WM_USER;
WM_CAP_STOP = WM_CAP_START + 68;
WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
WM_CAP_SAVEDIB = WM_CAP_START + 25;
WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
WM_CAP_SEQUENCE = WM_CAP_START + 62;
WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;

function capCreateCaptureWindowA(lpszWindowName : PCHAR;
dwStyle : longint;
x : integer;
y : integer;
nWidth : integer;
nHeight : integer;
ParentWin : HWND;
nId : integer): HWND;
stdcall external 'AVICAP32.DLL';
var
  Form1: TForm1;

implementation
{$R *.dfm}


var hWndC : THandle;

procedure TForm1.Button1Click(Sender: TObject);
begin
 hWndC := capCreateCaptureWindowA('My Own Capture Window',
WS_CHILD or WS_VISIBLE ,
0,
0,
Panel1.Width,
Panel1.Height,
Panel1.Handle,
0); //создаем область для вывода получаемых в будущем картинок =)

if hWndC <> 0 then //если при создании области ошибок не возникло, то сопкойно начинаем забирать данный с веб-камеры
SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);  //забираем картинку с вебкамеры

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  hWndC := 0;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if hWndC <> 0 then
  begin
    SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);  //"отключаемся" от веб-камеры
    hWndC := 0;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if hWndC <> 0 then SendMessage(hWndC, WM_CAP_GRAB_FRAME, 0, 0); //забираем картинку с вебкамеры
end;

procedure TForm1.Button3Click(Sender: TObject);
begin

end;

end.

Данный код делает фотку с вебки и показует ее на панельке. Как сделать что бы фотка сразу поместилась в TMemorystream?


_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор

[kutani]

...после коннекта к видеоустройству:

if hWndC <> 0 then
SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);

добавляем каллбэк на ваш граб по таймеру:

SendMessage(hWndC, WM_CAP_SET_CALLBACK_FRAME, 0, Integer(@cb));

Cам каллбэк c данными из видеоустройства:

var bt: BITMAPINFO;

function cb(hWnd: HWND; lpVHdr: PVIDEOHDR): DWORD; stdcall;
type
  TByteArray = array [0..1] of Byte;
  PByteArray = ^TByteArray;
var
  status : TCapStatus;
begin
  Result := 0;
  SendMessage(hWndC, WM_CAP_GET_STATUS, SizeOf(status), Integer(@status));

  //status.uiImageWidth // ширина кадра
  //status.uiImageHeight // высота кадра

  // копируем данные о цвете для прямоугольника пикселей в аппаратно-независимом растровом формате DIB
  bt.bmiHeader.biWidth  := status.uiImageWidth;
  bt.bmiHeader.biHeight := status.uiImageHeight;
  StretchDIBits(Panel1.Handle, 0, 0, 640, 480, 0, 0, status.uiImageWidth, status.uiImageHeight, lpVHdr.lpData, bt, 0, SRCCOPY); 

  // можно в MemoryStream
  MemoryStream.Write(lpVHdr^.lpData^, lpVhdr^.dwBytesUsed);
end;

как то так.

[BLACK_RAIN]

Если обращаться к камере этим способом, то могут возникать сообщения об ошибках. Например, если камера занята.
Лучше через DirectShow.

[kutani]

1- не все производители поддерживали DS в своих дровах (старые WEB-ки).
2- не всегда DS фильтр производителя камеры обеспечивает немонопольный доступ.
3- DS в любом случае лучше )

[Legeardo]

Дайте тогда пример с использованием дс

[Pavia]

1- не все производители поддерживали DS в своих дровах (старые WEB-ки).
2- не всегда DS фильтр производителя камеры обеспечивает немонопольный доступ.
3- DS в любом случае лучше )

1) В смысле не все? В DirectX есть фильтры для работы через VFW.
2) В Win10 VFW не включается самостоятельно до тех пор пока не будет хотябы раз запущен через DirectX. (по крайней мере на моей машине)
3) Скайп работает через DirectX.
4) Говорят с DX ошибок меньше.

[kutani]

Дайте тогда пример с использованием дс

http://www.programmersforum.ru/showp...8&postcount=17

1- VFW Capture то есть, но не со всеми камерами работает.
2- TC не озвучил ОС.
3- после покупки мелкософтом и переводом на Net и JAVA технологии стал гавном.
4- бабки тоже говорят.