Вебкамера

Тема в разделе "Delphi - Multimedia, Графика, Игры", создана пользователем VitAngel, 3 апр 2007.

Статус темы:
Закрыта.
  1. VitAngel

    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.
     
  2. VitAngel

    VitAngel Гость

    Спасибо, тема закрыта
     
  3. GrenDaiZer

    GrenDaiZer Гость

    А действительно почему данный код не работает??? Может надо как то камеру проинициализировать, потому что при запуске приложения обращения к камере нет, так как лампочка на камере не загорается.
     
  4. VitAngel

    VitAngel Гость

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

    http://xproger.mirgames.ru/?id=2&page=1 - XCam
     
  5. GrenDaiZer

    GrenDaiZer Гость

    Ага спасибо, покопаюсь ))
     
  6. MechWarrior

    MechWarrior Гость

    Если кому всё же интересно, почему код не работает - потому что не всё что нужно сделано. capCreateCaptureWindow - она просто окно создает, в котором будет выводится картинка. А к нему надо бы еще драйвер устройства подсоединить (с помощью capDriverConnect), который эту картинку выводит. Хотя вообще-то VFW (Video For Windows) устарело - наследие 3.1/9x. На системах NT/2k/XP может захватывать только одно поле (т.е. макс. размеры картинки 384x288). Лучше пользоваться DirectShow - это вещь существенно более мощная в любом отношении (описание в MSDN). Хотя и достаточно сложная для понимания. На Jedi помнится был когда-то компонент DXCapture для Delphi (с исходником и примером) для упрощения этого дела.
     
  7. Snickbw

    Snickbw Гость

    ПОЛНЫЙ КОД ПРИМЕРА ПЕРВОГО ПОСТА.
    Для использования следующиего примера необходимо иметь "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 http://www.sources.ru


    Только это работает с устройством видеозахвата (Web камера, TV тюнер, плата видеозахвата и т.п.) которое в системе зарегистрировано первым.
    Вопрос: кто подскажет пример для выбора устройств видеозахвата?
     
Загрузка...
Похожие Темы - Вебкамера
  1. Sergyon
    Ответов:
    10
    Просмотров:
    1.170
Статус темы:
Закрыта.

Поделиться этой страницей