Delphi - работа с web камерой.

[bombording]

Добрый день.
Имеется довольно банальная задача.

Форма с запуском просмотра того что видит веб камера. И одной кнопкой, которая сохраняет изображение в максимально возможном для камеры разрешении и качестве.

Собственно форма с кодом есть. В коде используется стандартная dll AVICAP32.DLL.
Всё работает и картинки сохраняются.
Но проблема в том что они сохраняются с разрешением 640x480.

Возможно ли, как ни будь, сохранять картинки в максимальном разрешении и качестве???

Спасибо!

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Panel1: TPanel;
    Button2: TButton;
    Button1: TButton;
    Panel2: TPanel;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button4Click(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,
Panel2.Width,
Panel2.Height,
Panel2.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 CaptureWebCam(FilePath: String);
begin
  if hWndC <> 0 then begin
  SendMessage(hWndC, WM_CAP_GRAB_FRAME, 0, 0);
  SendMessage(hWndC, WM_CAP_SAVEDIB, 0, longint(pchar(FilePath)));
  end;
end;

// Кнопка сохранения картинки

procedure TForm1.Button4Click(Sender: TObject);
var
  FilePath : String;
begin
  FilePath := ExtractFilePath(ParamStr(0))+'4466.bmp';
  CaptureWebcam(FilePath);
end;

end.

[raxp]

...а какое разрешение поддерживает ваша вебка?

// настройка драйвера захвата
  if SendMessage(h_cam, WM_CAP_DRIVER_CONNECT, 0, 0) <> 0 then
  begin
    SendMessage(h_cam, WM_CAP_GET_VIDEOFORMAT, SizeOf(Bt), LongInt(@Bt));
    Bt.bmiHeader.biWidth    := 320; // ваши ...поддерживаемые камерой
    Bt.bmiHeader.biHeight   := 240;
    Bt.bmiHeader.biSize     := SizeOf(Bt.bmiHeader);
    Bt.bmiHeader.biPlanes   := 1;
    Bt.bmiHeader.biBitCount := 24;
    SendMessage(h_cam, WM_CAP_SET_VIDEOFORMAT, SizeOf(Bt), LongInt(@Bt));
    SendMessage(h_cam, WM_CAP_SET_CALLBACK_FRAME, 0, Integer(@FrameCallback));
  end

[bombording]

Сообщение от raxp

...а какое разрешение поддерживает ваша вебка?

// настройка драйвера захвата
  if SendMessage(h_cam, WM_CAP_DRIVER_CONNECT, 0, 0) <> 0 then
  begin
    SendMessage(h_cam, WM_CAP_GET_VIDEOFORMAT, SizeOf(Bt), LongInt(@Bt));
    Bt.bmiHeader.biWidth    := 320; // ваши ...поддерживаемые камерой
    Bt.bmiHeader.biHeight   := 240;
    Bt.bmiHeader.biSize     := SizeOf(Bt.bmiHeader);
    Bt.bmiHeader.biPlanes   := 1;
    Bt.bmiHeader.biBitCount := 24;
    SendMessage(h_cam, WM_CAP_SET_VIDEOFORMAT, SizeOf(Bt), LongInt(@Bt));
    SendMessage(h_cam, WM_CAP_SET_CALLBACK_FRAME, 0, Integer(@FrameCallback));
  end

Она поддерживает 1920х1080 Full HD.
Спасибо, сегодня попробую.

[bombording]

Но вот здесь сказано:

http://www.programmersclub.ru/%D0%92...%D0%B7-avicap/
'Размер изображения не должен превышать 640х480 пикселей', 55);

[bombording]

Вообщем как и ожидалось.

    Bt.bmiHeader.biWidth    := #;
    Bt.bmiHeader.biHeight   := #;
    Bt.bmiHeader.biSize     := SizeOf(Bt.bmiHeader);
    Bt.bmiHeader.biPlanes   := 1;
    Bt.bmiHeader.biBitCount := 12;

Не позволил привысить 640 на 480

[raxp]

...на самом деле, это тема с форума и подумайте почему так там написано. Кстати, укажите тип вашей вебки, хотелось бы глянуть на ее параметры.

p.s.: используйте технологию DirectShow.