Вебкамера

  • Автор темы Автор темы VitAngel
  • Дата начала Дата начала
Статус
Закрыто для дальнейших ответов.
V

VitAngel

День добрый! Есть код, который почему-то не подключает к работе вебкамеру и на экране появляется просто "квадрат малевича". Подскажите, пожалуйста, что не так. Заранее благодарю

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, SUIButton;

type
TForm1 = class(TForm)
suiButton1: TsuiButton;
procedure suiButton1Click(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;
CamWND : HWND = 0;

implementation

{$R *.dfm}

procedure TForm1.suiButton1Click(Sender: TObject);
begin
CamWND:=capCreateCaptureWindowA('My Web Cam',WS_VISIBLE,100,100,300,300,0,0);
if CamWND <> 0 then
SendMessage(CamWND, WM_CAP_GRAB_FRAME, 0, 0);
end;

end.
 
А действительно почему данный код не работает??? Может надо как то камеру проинициализировать, потому что при запуске приложения обращения к камере нет, так как лампочка на камере не загорается.
 
Я этот код забросил. Воспользовался помощью XProger'а, который дал мне ссылку на программу, работающую с вебкамерой. чуток в ней порылся и нормально - заработала. Если надо -вот ссылка:

- XCam
 
Если кому всё же интересно, почему код не работает - потому что не всё что нужно сделано. capCreateCaptureWindow - она просто окно создает, в котором будет выводится картинка. А к нему надо бы еще драйвер устройства подсоединить (с помощью capDriverConnect), который эту картинку выводит. Хотя вообще-то VFW (Video For Windows) устарело - наследие 3.1/9x. На системах NT/2k/XP может захватывать только одно поле (т.е. макс. размеры картинки 384x288). Лучше пользоваться DirectShow - это вещь существенно более мощная в любом отношении (описание в MSDN). Хотя и достаточно сложная для понимания. На Jedi помнится был когда-то компонент DXCapture для Delphi (с исходником и примером) для упрощения этого дела.
 
ПОЛНЫЙ КОД ПРИМЕРА ПЕРВОГО ПОСТА.
Для использования следующиего примера необходимо иметь "Microsoft Video for Windows SDK". Пример показывает, как открыть видео устройство для захвата видео, как сграбить фрейм с устройства, как сохранить этот фрейм на диск в виде файла .BMP, как записать .AVI файл (со звуком, но без предварительного просмотра), и как закрыть устройство.
Замечание: Для работы примера необходимо иметь установленное устройство захвата видео (video capture device).

Пример:
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Panel1: TPanel;
OpenVideo: TButton;
CloseVideo: TButton;
GrabFrame: TButton;
SaveBMP: TButton;
StartAVI: TButton;
StopAVI: TButton;
SaveDialog1: TSaveDialog;
procedure FormCreate(Sender: TObject);
procedure OpenVideoClick(Sender: TObject);
procedure CloseVideoClick(Sender: TObject);
procedure GrabFrameClick(Sender: TObject);
procedure SaveBMPClick(Sender: TObject);
procedure StartAVIClick(Sender: TObject);
procedure StopAVIClick(Sender: TObject);
private
{ Private declarations }
hWndC : THandle;
CapturingAVI : bool;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

const WM_CAP_START = WM_USER;
const WM_CAP_STOP = WM_CAP_START + 68;
const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
const WM_CAP_SAVEDIB = WM_CAP_START + 25;
const WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
const WM_CAP_SEQUENCE = WM_CAP_START + 62;
const 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';

procedure TForm1.FormCreate(Sender: TObject);
begin
CapturingAVI := false;
hWndC := 0;
SaveDialog1.Options :=
[ofHideReadOnly, ofNoChangeDir, ofPathMustExist]
end;

procedure TForm1.OpenVideoClick(Sender: TObject);
begin
hWndC := capCreateCaptureWindowA('My Own Capture Window',
WS_CHILD or WS_VISIBLE ,
Panel1.Left,
Panel1.Top,
Panel1.Width,
Panel1.Height,
Form1.Handle,
0);
if hWndC <> 0 then
SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
end;

procedure TForm1.CloseVideoClick(Sender: TObject);
begin
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
hWndC := 0;
end;
end;

procedure TForm1.GrabFrameClick(Sender: TObject);
begin
if hWndC <> 0 then
SendMessage(hWndC, WM_CAP_GRAB_FRAME, 0, 0);
end;

procedure TForm1.SaveBMPClick(Sender: TObject);
begin
if hWndC <> 0 then begin
SaveDialog1.DefaultExt := 'bmp';
SaveDialog1.Filter := 'Bitmap files (*.bmp)|*.bmp';
if SaveDialog1.Execute then
SendMessage(hWndC,
WM_CAP_SAVEDIB,
0,
longint(pchar(SaveDialog1.FileName)));
end;
end;

procedure TForm1.StartAVIClick(Sender: TObject);
begin
if hWndC <> 0 then begin
SaveDialog1.DefaultExt := 'avi';
SaveDialog1.Filter := 'AVI files (*.avi)|*.avi';
if SaveDialog1.Execute then begin
CapturingAVI := true;
SendMessage(hWndC,
WM_CAP_FILE_SET_CAPTURE_FILEA,
0,
Longint(pchar(SaveDialog1.FileName)));
SendMessage(hWndC, WM_CAP_SEQUENCE, 0, 0);
end;
end;
end;

procedure TForm1.StopAVIClick(Sender: TObject);
begin
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_STOP, 0, 0);
CapturingAVI := false;
end;
end;

end.

Взято с Исходников.ru


Только это работает с устройством видеозахвата (Web камера, TV тюнер, плата видеозахвата и т.п.) которое в системе зарегистрировано первым.
Вопрос: кто подскажет пример для выбора устройств видеозахвата?
 
Статус
Закрыто для дальнейших ответов.
Мы в соцсетях:

Обучение наступательной кибербезопасности в игровой форме. Начать игру!