Пятница, 03.05.2024, 23:58
Приветствую Вас Гость

Не ошибается тот, кто ничего не делает.
Но и ничего не делать - ошибка.

Эмиль Кроткий

Меню сайта
Категории раздела
Работа с библиотеками BASS и DirectShow [14]
Статьи по написанию mp3 плеера, видеоплеера, работе с WEB камерой и т.д.
Форма входа

Статистика

Онлайн всего: 1
Гостей: 1
Пользователей: 0


















Тиц
Главная » Статьи » Мультимедиа » Работа с библиотеками BASS и DirectShow

Урок 3.2. Учимся работать с Web камерой в Delphi (Грабим изображение с камеры в файл).
Содержание

Урок 2.1. Пишем видеоплеер (проигрыватель видео) на Delphi с использованием технологии DirectShow.

Урок 2.2. Пишем видеоплеер (проигрыватель видео) на Delphi с использованием технологии DirectShow (продолжение).

Урок 3.1. Учимся работать с Web камерой в Delphi через архитектуру DirectShow.

Урок 3.2. Учимся работать с Web камерой в Delphi (Грабим изображение с камеры в файл).

Урок 3.2.

Учимся работать с Web камерой в Delphi.

Учимся работать с Web камерой в Delphi (Грабим изображение с камеры в файл).        На этом уроке мы научимся грабить отдельные кадры изображения с камеры , сжимать их и записывать их в файл, а затем отправлять полученное изображение по FTP протоколу на хостинг для сайта. Другими словами мы создадим простейшую программу для трансляции изображений с Web камеры на страницу сайта с использованием DirectShow.








     Создадим новое приложение в Delphi.
Затем добавим и расположим компоненты на форму как показано на рисунке:

Учимся работать с Web камерой в Delphi (Грабим изображение с камеры в файл).

      Слева вверху расположена Panel1 для вывода изображения с камеры. Справа располагается Panel2 с размещенным на ней компонентом TImage свойство Proportional у Image1 устанавливаем  True, в нем будем показывать с грабленое изображение. Под Panel1 размещаем компонент TListBox и кнопку TButton («Параметры и разрешение камеры»). Справа от ListBox1 размещаем восемь компонентов TLabel  и  семь компонентов TEdit. И девятый компонент Label9 с надписью Caption (Трансляция изображения остановлена) размещаем под панелями. Добавляем компонент TTimer свойство Enable устанавливаем False. На этом интерфейс приложения закончен.

     В целом граф захвата изображения с камеры, строится также как и в предыдущем уроке. Для получения кадра из потока данных Web камеры мы будем использовать интерфейсы IBaseFilter  и ISampleGrabber. Передавать данные по FTP будем с помощью модуля WinInet, а для сохранения настроек FTP воспользуемся модулем IniFiles.

    Ниже привожу полный код приложения с комментариями:

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,  StdCtrls, ExtCtrls, directshow9, ActiveX, Jpeg, WinInet, IniFiles; //не забудьте добавить выделенные модули

//Скачать заголовочные файлы DirectShow можно здесь.

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Panel1: TPanel;
    Button1: TButton;
    Panel2: TPanel;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit6: TEdit;
    Label6: TLabel;
    Label8: TLabel;
    Button2: TButton;
    Timer1: TTimer;
    Edit5: TEdit;
    Label5: TLabel;
    Button3: TButton;
    Label4: TLabel;
    Edit4: TEdit;
    Edit7: TEdit;
    Label7: TLabel;
    Label9: TLabel;
    function CreateGraph: HResult;
    function Initializ: HResult;
    function CaptureBitmap: HResult;
    procedure LoadIniFiles;
    procedure SaveIniFiles;

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure SendFtp;
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  IniFile: TIniFile;
  FileName: string;
  RecMode: boolean = False;
  DeviceName:OleVariant;
  PropertyName:IPropertyBag;
  pDevEnum:ICreateDEvEnum;
  pEnum:IEnumMoniker;
  pMoniker:IMoniker;

MArray1: array of IMoniker; //Это список моникеров, из которго
//мы потом будем получать необходмый моникер

//интерфейсы
    FGraphBuilder:        IGraphBuilder;
    FCaptureGraphBuilder: ICaptureGraphBuilder2;
    FMux:                 IBaseFilter;
    FSink:                IFileSinkFilter;
    FMediaControl:        IMediaControl;
    FVideoWindow:         IVideoWindow;
    FVideoCaptureFilter:  IBaseFilter;
    FAudioCaptureFilter:  IBaseFilter;
//область вывода изображения
    FVideoRect:           TRect;

    FBaseFilter:          IBaseFilter;
    FSampleGrabber:       ISampleGrabber;
    MediaType:            AM_MEDIA_TYPE;


implementation

{$R *.dfm}

function TForm1.Initializ: HResult;
begin
//Создаем объект для перечисления устройств
Result:=CoCreateInstance(CLSID_SystemDeviceEnum, NIL, CLSCTX_INPROC_SERVER,
IID_ICreateDevEnum, pDevEnum);
if Result<>S_OK then EXIT;

//Перечислитель устройств Video
Result:=pDevEnum.CreateClassEnumerator(CLSID_VideoInputDeviceCategory, pEnum, 0);
if Result<>S_OK then EXIT;
//Обнуляем массив в списке моникеров
setlength(MArray1,0);
//Пускаем массив по списку устройств
while (S_OK=pEnum.Next(1,pMoniker,Nil)) do
begin
setlength(MArray1,length(MArray1)+1); //Увеличиваем массив на единицу
MArray1[length(MArray1)-1]:=pMoniker; //Запоминаем моникер в масиве
Result:=pMoniker.BindToStorage(NIL, NIL, IPropertyBag, PropertyName); //Линкуем моникер устройства к формату хранения IPropertyBag
if FAILED(Result) then Continue;
Result:=PropertyName.Read('FriendlyName', DeviceName, NIL); //Получаем имя устройства
if FAILED(Result) then Continue;
//Добавляем имя устройства в списки
Listbox1.Items.Add(DeviceName);
end;

//Первоначальный выбор устройств для захвата видео
//Выбираем из спика камеру
if ListBox1.Count=0 then
   begin
      ShowMessage('Камера не обнаружена');
      Result:=E_FAIL;;
      Exit;
   end;
Listbox1.ItemIndex:=0;
//если все ОК
Result:=S_OK;
end;

function TForm1.CreateGraph:HResult;
var
  pConfigMux: IConfigAviMux;
begin
//Чистим граф
  FVideoCaptureFilter  := NIL;
  FVideoWindow         := NIL;
  FMediaControl        := NIL;
  FSampleGrabber       := NIL;
  FBaseFilter          := NIL;
  FCaptureGraphBuilder := NIL;
  FGraphBuilder        := NIL;

//Создаем объект для графа фильтров
Result:=CoCreateInstance(CLSID_FilterGraph, NIL, CLSCTX_INPROC_SERVER, IID_IGraphBuilder, FGraphBuilder);
if FAILED(Result) then EXIT;
// Создаем объект для граббинга
Result:=CoCreateInstance(CLSID_SampleGrabber, NIL, CLSCTX_INPROC_SERVER, IID_IBaseFilter, FBaseFilter);
if FAILED(Result) then EXIT;
//Создаем объект для графа захвата
Result:=CoCreateInstance(CLSID_CaptureGraphBuilder2, NIL, CLSCTX_INPROC_SERVER, IID_ICaptureGraphBuilder2, FCaptureGraphBuilder);
if FAILED(Result) then EXIT;

// Добавляем фильтр в граф
Result:=FGraphBuilder.AddFilter(FBaseFilter, 'GRABBER');
if FAILED(Result) then EXIT;
// Получаем интерфейс фильтра перехвата
Result:=FBaseFilter.QueryInterface(IID_ISampleGrabber, FSampleGrabber);
if FAILED(Result) then EXIT;

  if FSampleGrabber <> NIL then
  begin
    //обнуляем память
    ZeroMemory(@MediaType, sizeof(AM_MEDIA_TYPE));
    // Устанавливаем формат данных для фильтра перехвата
    with MediaType do
    begin
      majortype  := MEDIATYPE_Video;
      subtype    := MEDIASUBTYPE_RGB24;
      formattype := FORMAT_VideoInfo;
    end;

    FSampleGrabber.SetMediaType(MediaType);

    // Данные будут записаны в буфер в том виде, в котором они
    // проходят через фильтр
    FSampleGrabber.SetBufferSamples(TRUE);

    // Граф не будет остановлен для получения кадра
    FSampleGrabber.SetOneShot(FALSE);
  end;

//Задаем граф фильтров
Result:=FCaptureGraphBuilder.SetFiltergraph(FGraphBuilder);
if FAILED(Result) then EXIT;

//выбор устройств ListBox - ов
if Listbox1.ItemIndex>=0 then
           begin
              //получаем устройство для захвата видео из списка моникеров
              MArray1[Listbox1.ItemIndex].BindToObject(NIL, NIL, IID_IBaseFilter, FVideoCaptureFilter);
              //добавляем устройство в граф фильтров
              FGraphBuilder.AddFilter(FVideoCaptureFilter, 'VideoCaptureFilter'); //Получаем фильтр графа захвата
           end;

//Задаем, что откуда будем получать и куда оно должно выводиться
Result:=FCaptureGraphBuilder.RenderStream(@PIN_CATEGORY_PREVIEW, nil, FVideoCaptureFilter ,FBaseFilter  ,nil);
if FAILED(Result) then EXIT;

//Получаем интерфейс управления окном видео
Result:=FGraphBuilder.QueryInterface(IID_IVideoWindow, FVideoWindow);
if FAILED(Result) then EXIT;
//Задаем стиль окна вывода
FVideoWindow.put_WindowStyle(WS_CHILD or WS_CLIPSIBLINGS);
//Накладываем окно вывода на  Panel1
FVideoWindow.put_Owner(Panel1.Handle);
//Задаем размеры окна во всю панель
FVideoRect:=Panel1.ClientRect;
FVideoWindow.SetWindowPosition(FVideoRect.Left,FVideoRect.Top, FVideoRect.Right - FVideoRect.Left,FVideoRect.Bottom - FVideoRect.Top);
//показываем окно
FVideoWindow.put_Visible(TRUE);

//Запрашиваем интерфейс управления графом
Result:=FGraphBuilder.QueryInterface(IID_IMediaControl, FMediaControl);
if FAILED(Result) then Exit;
//Запускаем отображение просмотра с вебкамер
FMediaControl.Run();
end;

//с помощью этой функции будем грабить изображение
function TForm1.CaptureBitmap: HResult;
var
  bSize: integer;
  pVideoHeader: TVideoInfoHeader;
  MediaType: TAMMediaType;
  BitmapInfo: TBitmapInfo;
  Buffer: Pointer;
  tmp: array of byte;
  Bitmap: TBitmap;
  JpegIm: TJpegImage;
begin
  // Результат по умолчанию
  Result := E_FAIL;

  // Если  отсутствует интерфейс фильтра перехвата изображения,
  // то завершаем работу
  if FSampleGrabber = NIL then EXIT;

  // Получаем размер кадра
    Result := FSampleGrabber.GetCurrentBuffer(bSize, NIL);
    if (bSize <= 0) or FAILED(Result) then EXIT;
  // Создаем изображение
  Bitmap := TBitmap.Create;
  try
  //обнуляем память
  ZeroMemory(@MediaType, sizeof(TAMMediaType));
  // Получаем тип медиа потока на входе у фильтра перехвата
  Result := FSampleGrabber.GetConnectedMediaType(MediaType);
  if FAILED(Result) then EXIT;

    // Копируем заголовок изображения
    pVideoHeader := TVideoInfoHeader(MediaType.pbFormat^);
    ZeroMemory(@BitmapInfo, sizeof(TBitmapInfo));
    CopyMemory(@BitmapInfo.bmiHeader, @pVideoHeader.bmiHeader, sizeof(TBITMAPINFOHEADER));

    Buffer := NIL;

    // Создаем побитовое изображение
    Bitmap.Handle := CreateDIBSection(0, BitmapInfo, DIB_RGB_COLORS, Buffer, 0, 0);

    // Выделяем память во временном массиве
    SetLength(tmp, bSize);

    try
      // Читаем изображение из медиа потока во временный буфер
      FSampleGrabber.GetCurrentBuffer(bSize, @tmp[0]);

      // Копируем данные из временного буфера в наше изображение
      CopyMemory(Buffer, @tmp[0], MediaType.lSampleSize);

      //если необходимо сохранить изображение в bmp файле
      //Bitmap.SaveToFile('Имя файла.bmp');

      // Конвертируем изображение в Jpeg
      //создаем объект JpegImage
      JpegIm := TJpegImage.Create;
      //устанавливаем связь с объектом Bitmap
      JpegIm.Assign(Bitmap);
      //задаем степень сжатия
      JpegIm.CompressionQuality := 30;
      //сжимаем
      JpegIm.Compress;
      //сохраняем в файл
      FileName:=Edit7.Text;
      JpegIm.SaveToFile(FileName);

    except

      // В случае сбоя возвращаем ошибочный результат
      Result := E_FAIL;
    end;
  finally
    // Освобождаем память
    SetLength(tmp, 0);
    Bitmap.Free;
    JpegIm.Free;
  end;
end;

//процедура запускает процесс получения кадра и его переда по FTP
procedure TForm1.Button2Click(Sender: TObject);
begin
//проверяем если устройства для захвата изображения
if Listbox1.Count=0 then
    Begin
      ShowMessage('Внимание! Камера не обнаружена.');
      Exit;
    End;
//Грабим кадр и начинаем передачу изображения
if FAILED(CaptureBitmap) then
    Begin
      ShowMessage('Внимание! Произошла ошибка при получении изображения');
      Exit;
    End;
Label9.Caption:='Идет трансляция изображения';
SendFtp;
//запуск таймера с заданным интервалом
Timer1.Interval:=StrToInt(Edit6.Text)*1000;
Timer1.Enabled:=True;
end;

procedure TForm1.Button1Click(Sender: TObject);
//Вызов страницы свойств Web-камеры
var
  StreamConfig: IAMStreamConfig;
  PropertyPages: ISpecifyPropertyPages;
  Pages: CAUUID;
Begin
//если запись уже идет - выходим
If RecMode then Exit;
  // Если отсутствует интерфейс работы с видео, то завершаем работу
  if FVideoCaptureFilter = NIL then EXIT;
  // Останавливаем работу графа
  FMediaControl.Stop;
  try
    // Ищем интерфейс управления форматом данных выходного потока
    // Если интерфейс найден, то ...
    if SUCCEEDED(FCaptureGraphBuilder.FindInterface(@PIN_CATEGORY_CAPTURE,
      @MEDIATYPE_Video, FVideoCaptureFilter, IID_IAMStreamConfig, StreamConfig)) then
    begin
      // ... пытаемся найти интерфейс управления страницами свойств ...
      // ... и, если он найден, то ...
      if SUCCEEDED(StreamConfig.QueryInterface(ISpecifyPropertyPages, PropertyPages)) then
      begin
        // ... получаем массив страниц свойств
        PropertyPages.GetPages(Pages);
        PropertyPages := NIL;

        // Отображаем страницу свойств в виде модального диалога
        OleCreatePropertyFrame(
           Handle,
           0,
           0,
           PWideChar(ListBox1.Items.Strings[listbox1.ItemIndex]),
           1,
           @StreamConfig,
           Pages.cElems,
           Pages.pElems,
           0,
           0,
           NIL
        );

        // Освобождаем память
        StreamConfig := NIL;
        CoTaskMemFree(Pages.pElems);
      end;
    end;

  finally
    // Восстанавливаем работу графа
    FMediaControl.Run;
  end;
end;

//остановка передачи изображения
procedure TForm1.Button3Click(Sender: TObject);
begin
Label9.Caption:='Трансляция изображения остановлена';
Timer1.Enabled:=False;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
//загружаем настройки из ini файла
LoadIniFiles;
CoInitialize(nil);// инициализировать OLE COM
//вызываем процедуру поиска и инициализации устройств захвата видео и звука
if FAILED(Initializ) then
    Begin
      ShowMessage('Внимание! Произошла ошибка при инициализации');
      Exit;
    End;
//проверяем найденный список устройств
if Listbox1.Count>0 then
    Begin
        //если необходимые для работы устройства найдены,
        //то вызываем процедуру построения графа фильтров
        if FAILED(CreateGraph) then
            Begin
              ShowMessage('Внимание! Произошла ошибка при построении графа фильтров');
              Exit;
            End;
    end else
            Begin
              ShowMessage('Внимание! Камера не обнаружена.');
              //Application.Terminate;
            End;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
// Освобождаем память
        pEnum := NIL;
        pDevEnum := NIL;
        pMoniker := NIL;
        PropertyName := NIL;
        DeviceName:=Unassigned;
        CoUninitialize;// деинициализировать OLE COM
//сохраняем настройки в inifile
SaveIniFiles;
IniFile.Free;
end;


//Выбор устройств из ListBox1
procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
if ListBox1.Count=0 then
    Begin
       ShowMessage('Камера не найдена');
       Exit;
    End;
//перестраиваем  граф при смене камеры
if FAILED(CreateGraph) then
    Begin
      ShowMessage('Внимание! Произошла ошибка при построении графа фильтров');
      Exit;
    End;
end;


procedure TForm1.Timer1Timer(Sender: TObject);
begin
//грабим кадр
if FAILED(CaptureBitmap) then
    Begin
      ShowMessage('Внимание! Произошла ошибка при получении изображения');
      Exit;
    End;
//вызываем процедуру пересылки изображения по FTP
SendFtp;
end;

//Передача файла по FTP
procedure TForm1.SendFtp;
var Username,Password,Folder, Port, Server:String;
inet_open, conn_param :pointer;
begin
//Передача файла по FTP
  Folder:=Edit5.Text;
  Username:=Edit2.Text;
  Password:=Edit3.Text;
  Port:=Edit4.Text;
  Server:=Edit1.Text;
  FileName:=Edit7.Text;
//выводим отправляемую картинку в Image1
  Image1.Picture.LoadFromFile(FileName);
  //Открываем интернет соединение
  inet_open:= internetopen('iexplore',INTERNET_OPEN_TYPE_DIRECT,nil,nil,0);
  //подключаемся к FTP серверу
 conn_param:=internetconnect(inet_open, PChar(Server), strtoint(Port), PChar(Username), PChar(Password), INTERNET_SERVICE_FTP,INTERNET_FLAG_PASSIVE,0);
  //задаем директорию для копирования файла
  FtpSetCurrentDirectory(conn_param, PChar(Folder));
  //Передаем файл по FTP
  if ftpputfile(conn_param,PChar(FileName),PChar(FileName), FTP_TRANSFER_TYPE_UNKNOWN,0)=false then
  begin
  ShowMessage('Ошибка. Загрузка не удалась!');
  Label9.Caption:='Трансляция изображения остановлена';
  Timer1.Enabled:=false;
  end;
  //выдаем звуковой сигнал об успешной отправке изображения
  beep;
  //Закрываем соединение
  internetclosehandle(conn_param);
  internetclosehandle(inet_open) ;
end;

//процедура загрузки данных из inifile
procedure TForm1.LoadIniFiles;
begin
//создание inifile  с именем Config.ini
IniFile:=TIniFile.Create(ExtractFilePath(Application.ExeName)+'config.ini');
//загрузка настроек из inifile
//положение формы и размер
  Form1.Left:=IniFile.ReadInteger('Form info','Left',285);
  Form1.Top:=IniFile.ReadInteger('Form info','Top',168);
//Параметры FTP сервера
  Edit1.Text:=IniFile.ReadString('FTP','Host','');
  Edit2.Text:=IniFile.ReadString('FTP','UserName','');
  Edit3.Text:=IniFile.ReadString('FTP','Password','');
  Edit4.Text:=IniFile.ReadString('FTP','Port','21');
  Edit5.Text:=IniFile.ReadString('FTP','Folder','/');
  Edit6.Text:=IniFile.ReadString('FTP','Interval','20');
  Edit7.Text:=IniFile.ReadString('FTP','FileName','');
end;

//процедура сохранения настроек в inifile
procedure TForm1.SaveIniFiles;
begin
//сохраняем настройки в inifile
//форма
  IniFile.WriteInteger('Form info','Left',Left);
  IniFile.WriteInteger('Form info','Top',Top);
//Параметры FTP сервера
  IniFile.WriteString('FTP','Host',Edit1.Text);
  IniFile.WriteString('FTP','UserName',Edit2.Text);
  IniFile.WriteString('FTP','Password',Edit3.Text);
  IniFile.WriteString('FTP','Port',Edit4.Text);
  IniFile.WriteString('FTP','Folder',Edit5.Text);
  IniFile.WriteString('FTP','Interval',Edit6.Text);
  IniFile.WriteString('FTP','FileName',Edit7.Text);
end;
end.

Далее на сам сайт ставите следующий скрипт в HTML:

код автоподгрузки изображения с WEB камеры на сайте:

<html>
<head><title>Play Web Camera</title>
</head>

<body><center>

<script language="JavaScript">
function go()
{
  var now = new Date();
  var id= parseInt(now.getTime() / 1000);
  document.images.cam.src="path/image.jpg?"+id;
  setTimeout("go()", 5000);
}
setTimeout("go()", 5000);
</script>
<body>

<div align="center">
<b>Тест Web камеры</b><br><br>
<img src="path/image.jpg" name="cam"><br>
</div>
</body>
</html>


       Данный скрипт позволяет обновлять изображение на сайте каждые 5 секунд. В место path/image.jpg вы должны указать свое подгружаемое изображение. Для изменения времени обновления в место 5000 (5 секунд) укажите свое значение.
Сохраняем и тестируем приложение.

Учимся работать с Web камерой в Delphi (Грабим изображение с камеры в файл).

На сайте:

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

В статье использованы материалы из книги "Есенин С.А. DirectX и Delphi. Разработка графических и мультимедийных приложений".

Спасибо за внимание.

Скачать исходники к статье можно здесь.

      В связи с возникающими вопросами по получению изображения с камеры выкладываю исходник, который просто позволяет получить изображение и поместить его на canvas.

Скачать исходники  можно здесь.

Автор статьи xaramamburu, сайт автора http://basicsprog.ucoz.ru .




Категория: Работа с библиотеками BASS и DirectShow | Добавил: xaramamburu (30.10.2011)
Просмотров: 39730 | Комментарии: 50 | Рейтинг: 5.0/4
Всего комментариев: 50« 1 2
12 SarmaT2  
0
Если заменить
MEDIASUBTYPE_RGB24
на 
 MEDIASUBTYPE_YUY2

То при попытке сграбить картинку вылезает ошибка.

13 xaramamburu  
0
Какая? sad

9 Gangboy  
0
Подскажите плиз , а как это изображение с камментариями потом сохранить в базу данных на локальный диск?Буду очень признателен за ответ, т.к. в программировании приложений не очень...(

10 xaramamburu  
0
Что значит сохранить в базу? Какая база? Какой способ подключения?

8 sancho  
0
... Если сразу же после CreateGraph вызвать CaptureBitmap, то при попытке получить размер кадра FSampleGrabber.GetCurrentBuffer получаем VFW_E_WRONG_STATE. Похоже, надо пождать какое-то время, пока камера не будет готова отдать кадр. Возможно, надо было делать CaptureBitmap по какому-то событию?

7 sancho  
0
Автору статьи - огромное спасибо! Все очень доходчиво и понятно.

В процессе изучения кода примера kamera_pol_izobr возник вопрос: можно ли сделать тоже самое, но только без отображения того, что сейчас видит камера ? Что вроде того - нажали кнопку, камера включилась, сделала снимок и выключилась.

Спасибо.

17 Inveise  
0
По сути это тривиальная задача - нужно выставить нулевой фильтр видео рендера. Но результат нарандомить не удалось biggrin
Копать дальше "что как и зачем" стимула у меня нет сейчас.
Выводится куда-то видео поток и ладно, шпионов не пишем ))
Может кто из забредших сюда решение приведет...

18 xaramamburu  
0
У меня эта проблема решилась установкой фильтра SamleGrabber в качестве конечного фильтра. В строке
//Задаем, что откуда будем получать и куда оно должно выводиться
Result:=FCaptureGraphBuilder.RenderStream(@PIN_CATEGORY_PREVIEW, nil, FVideoCaptureFilter , FBaseFilter  ,nil);
Меняем местами последние два фильтра:
FCaptureGraphBuilder.RenderStream(@PIN_CATEGORY_PREVIEW, nil,FVideoCaptureFilter ,nil, FBaseFilter  );
smile

19 sancho  
0
Ответа не дождался, так что сам сделал вот так:

Код
function PrepareSnapshotNonUI(var ErrorMessage: String): Boolean;
var
   pCaptureGraphBuilder: ICaptureGraphBuilder2;
   pGraphBuilder: IGraphBuilder;
   pNullRenderer: IBaseFilter;
   pEvent: IMediaEvent;
begin
   Result := False;

   try
     FilterGraph.ClearGraph;
     FilterGraph.Active := False;
     Source.BaseFilter.Moniker := FSysDev.GetMoniker(cbDevices.ItemIndex);

     if not Assigned(Source.BaseFilter.Moniker) then begin
       ErrorMessage := 'You should configure the camera before making the snapshot.';
       Exit;
     end;

     FilterGraph.Active := True;

     FilterGraph.QueryInterface(ICaptureGraphBuilder2, pCaptureGraphBuilder);
     FilterGraph.QueryInterface(IGraphBuilder, pGraphBuilder);
     pNullRenderer := CreateComObject(CLSID_NullRenderer) as IBaseFilter;
     pGraphBuilder.AddFilter(pNullRenderer, 'Null Renderer');
     pGraphBuilder.QueryInterface(IMediaEvent, pEvent);

     if cbResolutions.Items.Count = 0 then
       RefreshResolution;

     if cbResolutions.ItemIndex >= 0 then
       DoResolutionSelect
         (integer(cbResolutions.Items.Objects[cbResolutions.ItemIndex]));

     pCaptureGraphBuilder.RenderStream(@PIN_CATEGORY_CAPTURE, nil,
       Source as IBaseFilter, SampleGrabber as IBaseFilter, pNullRenderer);

     FilterGraph.Play;
     Result := True;
   except
     on E:Exception do begin
       Result := False;
       ErrorMessage := Format('%s'#13#10'%s', [E.ClassName, E.Message]);
     end;
   end;
end;

function MakeSnapshotNonUI: Boolean;
var
  MaxTick: cardinal;
  BufferLen: integer;
  HR: HRESULT;
  JPG: THackJPEGImage;
begin
  MaxTick := GetTickCount + 5000;
  repeat
  // get buffer size
  BufferLen := 0;
  HR := SampleGrabber.SampleGrabber.GetCurrentBuffer(BufferLen, Nil);
  Application.ProcessMessages;
  if ((HR <> S_OK) or (BufferLen = 0)) and (GetTickCount < MaxTick) then
  Sleep(1500);
  until ((HR = S_OK) and (BufferLen > 0)) or (GetTickCount >= MaxTick);

  JPG := THackJPEGImage.Create;
  try
  JPG.NewBitmap;
  SampleGrabber.GetBitmap(JPG.Bitmap);
  JPG.SaveToFile(FSnapshotFile);
  finally
  JPG.Free;
  end;

  FilterGraph.Stop;
end;



Работает так:
Код

if PrepareSnapshotNonUI then begin
  if MessageBox(...) = IDYES then
  MakeSnapshotNonUI;
end;


Но столкнулся с проблемой (см. мой пост выше от 21.12.2012) - надо как-то ждать готовность камеры. Цикл в начале функции MakeSnapshotNonUI - моя попытка решить это.
Поправьте, если где-то ошибся или если есть более правильное решение.

20 xaramamburu  
0
К сожалению не было времени на проработку вашего вопроса, вот только сегодня добрался. Но вы уже как я вижу сами до всего  дошли. Думаю я лучше ничего не предложу. Все равно, как ни крути камера мгновенно не инициализируется, а прохождение данных через SampleGrabber (BufferLen > 0) нужно как-то проверять, иначе вылетает ошибка или сохраняется пустой кадр.  Да еще как вариант предлагают использовать функцию (я думаю этот вариант более предпочтительный, судя по описанию функции):
а) Callback mode  (вызов ф-ии на каждом кадре)  { два способа:
а1) ISampleGrabber.SetCallback(ISampleGrabberCB, 0) -> будет вызываться
SampleCB
а2) ISampleGrabber.SetCallback(ISampleGrabberCB, 1) -> будет вызываться
BufferCB
Если ISampleGrabberCB = nil, то режим Callback заканчивается.
ISampleGrabberCB содержит методы BufferCB (получает указатель на копию
последнего кадра, sample buffer)
и SampleCB (получает указатель на кадр, IMediaSample)

б) ISampleGrabber.SetOneShot(true) получает один кадр и останавливает граф.
Пример. После поиска позиции захватить один кадр:
// Set one-shot mode and buffering.
hr:= pGrabber.SetOneShot(TRUE);
но, я так и не успел это опробовать. Может когда нибудь и соберусь. Вот здесь есть пример http://borland.xportal.ru/forum....4c89a   или здесь http://programmersforum.ru/showthread.php?p=569319#post569319 .))))))))))

5 max  
0
Здравствуйте. перед мной стоит задача написать программу которая может показывать изображение с камеры с ходу накладывать текст и периодически записывать все это в AVI файл. все реализовал (естественно с помощью ваших исходников =) ) кроме последнего, файл записывается чисто с камеры (без наложенного текста). Понимаю что нужно добавить/исправить пару строчек но ничего не получается((
http://www.sendspace.com/file/omp9yi
вот к чему я пришел, помогите пожалуйста...

6 xaramamburu  
0
Думаю здесь все не так просто, вы использовали мой исходник где изображение накладывается на видео в фильтре Video Renderer, к сожалению это виртуальное наложение и его записать нельзя. Сейчас у меня нет времени этим заниматься, но когда я писал эти статьи, на разных форумах задавались подобные вопросы, конечно ничего конкретного не было, но можно было проследить два возможных решения:
1. Это использование фильтра SampleGrabber т.е. пропускать поток с камеры через него, получать кадр изображения, накладывать на него текст, а затем с помощью Back (обратной) функции возвращать изображение в поток, а затем этот поток записывать в файл. Как и с какой скоростью это будет работать я не знаю. Даже вроде фрагменты исходников в данной реализации в интернете проскакивали.
2. Попробовать найти (подобрать) фильтр (Mixer), который позволяет смешивать видео и изображения, и уже с его выхода производить запись. Попробуйте поэкспериментировать в программе GraphStudio с различными фильтрами.))))

4 xaramamburu  
1
Может, кому пригодится. Есть функция, она служит для установки параметров захвата видео потока с камеры, позволяет регулировать такие параметры как частота видеосъемки, разрешение картинки, и количество бит на пиксель.

//=========================================================
function SetVideoParams(CB_B2: ICaptureGraphBuilder2; Category: TGUID;
fSource: IBaseFilter): HResult;
var
StreamConf: IAMStreamConfig;
PAMT: PAMMediaType;
begin
Result:= E_FAIL;
StreamConf:= nil;
PAMT:= nil;
try
Result:= CB_B2.FindInterface(@Category, @MEDIATYPE_Video, fSource, IID_IAMStreamConfig, StreamConf);
if Assigned(StreamConf) then
begin
StreamConf.GetFormat(PAMT);
if Assigned(PAMT) then
begin
if PAMT.cbFormat= sizeOf(TVideoInfoHeader) then
begin
PVIDEOINFOHEADER(PAMT^.pbFormat)^.bmiHeader.biWidth:= 768;//разрешение по ширине
PVIDEOINFOHEADER(PAMT^.pbFormat)^.bmiHeader.biHeight:= 576;//разрешение по высоте
PVIDEOINFOHEADER(PAMT^.pbFormat)^.bmiHeader.biBitCount:= 24; //rgb24
PVIDEOINFOHEADER(PAMT^.pbFormat)^.AvgTimePerFrame:= 10000000 div 25; //25 fps
with PVIDEOINFOHEADER(PAMT^.pbFormat)^.bmiHeader do
PAMT^.lSampleSize := ((biWidth + 3) and (not (3))) * biHeight * biBitCount shr 3;
PVIDEOINFOHEADER(PAMT^.pbFormat)^.bmiHeader.biSizeImage:= PAMT^.lSampleSize;
end;
Result:= StreamConf.SetFormat(PAMT^)
end;
end;
result:= S_OK;
except
on E: Exception do
MessageBox(0, PChar(E.Message), '', MB_OK or MB_ICONERROR);
end;
StreamConf:= nil;
if Assigned(PAMT) then
DeleteMediaType(PAMT);
end;

Функция DeleteMediaType из модуля DSUtils пакета DSPack.

//Пример вызова функции
//============================================================
//перед вызовом функции нужно остановить граф
SetVideoParams(FilterGraph as ICaptureGraphBuilder2, PIN_CATEGORY_CAPTURE, SourceFilter as IBaseFilter);
//после вызова нужно запустить граф снова
//============================================================

15 Inveise  
0
Немного подпилил данный код с учетом именований переменных в исходнике.


16 xaramamburu  
0
Ок, может кому пригодится.))))

41 booratino  
0
Камера не меняет параметров. Где я не правильно списал? smile

Вот сокращенный код построения пирамиды. Все вызовы проходят без ошибок.

CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC_SERVER, IID_IGraphBuilder, FGraphBuilder);
CoCreateInstance(CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC_SERVER, IID_ICaptureGraphBuilder2, FCaptureGraphBuilder);
CoCreateInstance(CLSID_SampleGrabber, nil, CLSCTX_INPROC_SERVER, IID_IBaseFilter, FBaseFilter);
FGraphBuilder.AddFilter(FBaseFilter, 'GRABBER');
FBaseFilter.QueryInterface(IID_ISampleGrabber, FSampleGrabber);
if FSampleGrabber <> nil
then begin
         ZeroMemory(@MediaType, sizeof(AM_MEDIA_TYPE));
         MediaType.majortype  := MEDIATYPE_Video;
         MediaType.subtype    := MEDIASUBTYPE_RGB24;
         MediaType.formattype := FORMAT_VideoInfo;
         FSampleGrabber.SetMediaType(MediaType);
         FSampleGrabber.SetBufferSamples(True);
         FSampleGrabber.SetOneShot(False);
         end;
FCaptureGraphBuilder.SetFiltergraph(FGraphBuilder);
varray[cameraptr].BindToObject(nil, nil, IID_IBaseFilter, FVideoCaptureFilter);
FGraphBuilder.AddFilter(FVideoCaptureFilter, 'VideoCaptureFilter');
(А)
FCaptureGraphBuilder.RenderStream(@PIN_CATEGORY_PREVIEW, @MEDIATYPE_Video, FVideoCaptureFilter, FBaseFilter, nil);
FGraphBuilder.QueryInterface(IID_IVideoWindow, FVideoWindow);
FVideoWindow.put_WindowStyle(WS_CHILD or WS_CLIPSIBLINGS);
FVideoWindow.put_Owner(SCR.Handle);
FVideoRect := SCR.ClientRect;
FVideoWindow.SetWindowPosition(FVideoRect.Left,FVideoRect.Top, FVideoRect.Right - FVideoRect.Left,FVideoRect.Bottom - FVideoRect.Top);
FVideoWindow.put_Visible(TRUE);
FGraphBuilder.QueryInterface(IID_IMediaControl, FMediaControl);
FMediaControl.Run;

Это процедура изменения параметров камеры.   Для теста включаю 320 х 200, камера это поддерживает.

function SetVideoParams(CB_B2: ICaptureGraphBuilder2; Category: TGUID; fSource: IBaseFilter): HResult;
var StreamConf: IAMStreamConfig; PAMT: PAMMediaType; VideoInfoHeader: TVideoInfoHeader;

procedure _FreeMediaType(mt: PAMMediaType); begin   .... end;
procedure _DeleteMediaType(pmt: PAMMediaType); begin  .... end;

begin

Result := E_FAIL;
StreamConf := nil;
PAMT := nil;

try
Result := CB_B2.FindInterface(@Category, @MEDIATYPE_Video, fSource, IID_IAMStreamConfig, StreamConf);
if Assigned(StreamConf)
then begin
     StreamConf.GetFormat(PAMT);
     if Assigned(PAMT)
     then begin
          if PAMT.cbFormat = sizeOf(TVideoInfoHeader)
          then begin
               VideoInfoHeader := PVIDEOINFOHEADER(PAMT^.pbFormat)^;
               VideoInfoHeader.bmiHeader.biWidth := 320; //разрешение по ширине
               VideoInfoHeader.bmiHeader.biHeight := 200; //разрешение по высоте
               VideoInfoHeader.bmiHeader.biBitCount := 24; //rgb24
               VideoInfoHeader.AvgTimePerFrame := 10000000 div 30; //25 fps
               with VideoInfoHeader.bmiHeader do PAMT^.lSampleSize := ( ((biWidth+3) shr 2) shl 2 ) * biHeight * (biBitCount div 8);
               VideoInfoHeader.bmiHeader.biSizeImage := PAMT^.lSampleSize;
               end;
          //PAMT^.pbFormat := PVIDEOINFOHEADER(PAMT^.pbFormat);  там этот адрес уже есть.  работает и без этого
          Result := StreamConf.SetFormat(PAMT^);                < -----   возвращает 0, т.е. отрабатывает без ошибок?  
          end;
     end;

result := S_OK;
except
on E: Exception do MessageBox(0, PChar(E.Message), '', MB_OK or MB_ICONERROR);
end;

StreamConf := nil;
if Assigned(PAMT) then _DeleteMediaType(PAMT);
end;

вызываю ее так:

FMediaControl.Stop;
SetVideoParams(FCaptureGraphBuilder, PIN_CATEGORY_CAPTURE, FVideoCaptureFilter);
FMediaControl.Run;

 StreamConf.SetFormat(PAMT^) возвращает 0, т.е., как я понимаю, это S_OK. Но разрешение камеры не менется. Это можно увидеть при повторном StreamConf.GetFormat(PAMT); Как было 640х480 по умолчанию, так и осталось. Также пробовал ее вызвать в точке (А), никакого эффекта.

42 xaramamburu  
0
Вот код который использовал я:

Код
procedure TForm1.SetVideoParams;
var
   StreamConfig: IAMStreamConfig;
   PAMT: PAMMediaType; {AM_MEDIA_TYPE;}

begin
   //
   PAMT:=nil;
   StreamConfig:= nil;
   // Если отсутствует интерфейс работы с видео, то завершаем работу
   if FVideoCaptureFilter = NIL then EXIT;
   // Останавливаем работу графа
   FMediaControl.Stop;

     // Ищем интерфейс управления форматом данных выходного потока
     // Если интерфейс найден, то ...
     if SUCCEEDED(FCaptureGraphBuilder.FindInterface(@PIN_CATEGORY_CAPTURE,
       @MEDIATYPE_Video, FVideoCaptureFilter, IID_IAMStreamConfig, StreamConfig)) then
     begin
       // ... пытаемся найти интерфейс управления страницами свойств ...

       StreamConfig.GetFormat(PAMT);

      if Assigned(PAMT) then
       begin
if PAMT.cbFormat= sizeOf(TVideoInfoHeader) then
begin
PVIDEOINFOHEADER(PAMT^.pbFormat)^.bmiHeader.biWidth:=320;
PVIDEOINFOHEADER(PAMT^.pbFormat)^.bmiHeader.biHeight:= 240;
PVIDEOINFOHEADER(PAMT^.pbFormat)^.bmiHeader.biBitCount:=24;
PVIDEOINFOHEADER(PAMT^.pbFormat)^.AvgTimePerFrame:= 10000000 div 25;
  beep;
with PVIDEOINFOHEADER(PAMT^.pbFormat)^.bmiHeader do
PAMT^.lSampleSize := ((biWidth + 3) and (not (3))) * biHeight * biBitCount
shr 3;
PVIDEOINFOHEADER(PAMT^.pbFormat)^.bmiHeader.biSizeImage:=PAMT^.lSampleSize;
end;
PAMT^.pbFormat:=PVIDEOINFOHEADER(PAMT^.pbFormat);
StreamConfig.SetFormat(PAMT^);
end;
end;

         // Освобождаем память
         StreamConfig := NIL;
         //if Assigned(PAMT) then _DeleteMediaType(PAMT);
end;
Проверял, у меня на ноутбуке работает.)))

43 booratino  
0
Да, теперь понял в чем было дело. smile   VideoInfoHeader это другая переменная, а надо менять в PVIDEOINFOHEADER(PAMT^.pbFormat)^. Я почему-то упорно думал, что это указатель на ту структуру. :)))  Спасибо.

3 Sk1f  
0
Ясно, спасибо огромное.

1 Sk1f  
0
Здравствуйте. А можно ли с помощью ДиректШоу сравнить два изображения, допустим попиксельно?
Мне, допустим, нужно разглядеть с помощью вебкамеры пиксели определенного цвета(грязное стекло), сравнить их с эталонным изображением (чистое стекло) и выдать сообщение о бракованном стекле. Или ДиректШоу с этим не справится и нужно подключать другие вещи? wink

2 xaramamburu  
0
Думаю, что DirectShow вам здесь не поможет. DirectShow это надстройка для работы с мультимедиа устройствами, поэтому если вам удалось получить изображение с Web камеры, то DirectShow свою работу сделало. Далее вам необходимо анализировать ваше изображение. Если вы просто хотите сравнить два изображение по пиксельно, то работайте со свойствами канвы здесь есть пример как сравнить два bitmap http://www.cyberforum.ru/delphi/thread64904.html, но думаю, что это будет очень медленно и не приведет к желаемому результату.Нужно искать более сложные алгоритмы анализа изображений.)))))

11 SarmaT2  
0
Если делать через canvas.pixels[i,i2], то программа будет много времени тратить на вызов процедур для получения и записи цвета точки.

Однако в примере автора есть место откуда можно вытащить рисунок и работать с ним без  торможения. Например, записать цвета в массив  data:array[0..639,0..479] of Tcolor
ищешь строку:
   
FSampleGrabber.GetCurrentBuffer(bSize, @tmp[0]);

и далее пишешь например так
for i:=0 to bitmap.Width-1 do
for i2:=0 to bitmap.height-1 do
   data[i,bitmap.height-1-i2]:=tmp[(i*3+(i2)*bitmap.Width*3)];// это если тебе не нужен цвет, а камера работает в чбрежиме ( data:array[0..639,0..479] of byte)

или если нужен цвет
for i:=0 to bitmap.Width-1 do
for i2:=0 to bitmap.height-1 do
   data[i,bitmap.height-1-i2]:=tmp[(i*3+(i2)*bitmap.Width*3)]*256*256 + tmp[(i*3+(i2)*bitmap.Width*3)+1]*256+  tmp[(i*3+(i2)*bitmap.Width*3)+2] ;//  ( data:array[0..639,0..479] of Tcolor) 

Это для формата RGB24. Там три байта. Но я не уверен в том какой байт умножать на 256 и 256*256, у меня камера не цветная, сам можешь протестить.

1-10 11-18
Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Поиск
Наш опрос
Оцените мой сайт
Всего ответов: 586
Уголок общения



Copyright MyCorp © 2024Конструктор сайтов - uCoz