Тема: Знімок з Веб-камери на Дельфі 7

Як отримати фотографію з веб-камери?

С++ головного мозку
Розмовляю Українською, пишу С+плюсом

2 Востаннє редагувалося Itari (01.11.2015 16:31:22)

Re: Знімок з Веб-камери на Дельфі 7

Таке пiдходить?: http://www.programmersclub.ru/%D0%9F%D0 … %80%D1%8B/
Або це: http://basicsprog.ucoz.ru/publ/6-1-0-27

Подякували: leofun011

3

Re: Знімок з Веб-камери на Дельфі 7

Звiсно, що пiдходить. Як першоджерело обох матерiалiв пiдтверджую :)

лови

Білоруський журнал «Радиолюбитель»
Lead Radar systems engineer & Software developer of industrial automation
Мої розробки та відеоблог

4

Re: Знімок з Веб-камери на Дельфі 7

А чи можливо зробити кадр з відеопотоку(тобто запрограмувати кнопку СФОТОГРАФУВАТИ так, щоб натискання на цю кнопку(під час зйомки відео) записувало поточний кадр з відео у файл, як окрему фотографію)?

С++ головного мозку
Розмовляю Українською, пишу С+плюсом

5

Re: Знімок з Веб-камери на Дельфі 7

Друге посилання з другого посту якраз і робить кадр з вебки. Чи вам треба з уже записаного відео?

6

Re: Знімок з Веб-камери на Дельфі 7

А чи можливо зробити кадр з відеопотоку

можливо, ISampleGrabber саме це й робить. Посилання 3-го поста процедура GetBitmap().

Білоруський журнал «Радиолюбитель»
Lead Radar systems engineer & Software developer of industrial automation
Мої розробки та відеоблог

7

Re: Знімок з Веб-камери на Дельфі 7

Дякую всім, зробив фото. Але виникає нове питання. Коли я обєднав юніт і форму відеокамери з програмою фотокамери, у мене замість запису відео чорний екран (я використовую radiobutton для переходу від форми фотокамери до форми відеокамери під час виконання програми). Видимість та доступність форми для фотокамери спочатку true (для відеокамери-false). Коли натискаю на radiobutton, властивості змінюються (true на false, false на true), відкривається 2-а форма. Але чому замість запису відео чорний екран (обєкт ПАНЕЛЬ)?

С++ головного мозку
Розмовляю Українською, пишу С+плюсом

8

Re: Знімок з Веб-камери на Дельфі 7

Будьте конкретніше, у вашому посту немає ні байта інформації, що відноситься до захоплення вiдео. Робота з формами не має ні найменшого відношення до сабжу.

Білоруський журнал «Радиолюбитель»
Lead Radar systems engineer & Software developer of industrial automation
Мої розробки та відеоблог

9

Re: Знімок з Веб-камери на Дельфі 7

чому замість запису відео чорний екран

Код треба дивитися. Або телепатію очуняти...

10

Re: Знімок з Веб-камери на Дельфі 7

КиївОболонь
Підозрюю, що одночасно з однієї вебки можна або робити знімки, або записувати відео. Так от просте приховування форми не призводить до зупинки роботи з вебкою. А взагалі Itari правий, без коду можна лише робити припущення.

11

Re: Знімок з Веб-камери на Дельфі 7

Torbins написав:

КиївОболонь
Підозрюю, що одночасно з однієї вебки можна або робити знімки, або записувати відео. Так от просте приховування форми не призводить до зупинки роботи з вебкою. А взагалі Itari правий, без коду можна лише робити припущення.

Тобто під час переходу на 2-у форму потрібно закривати першу?( хоча при закритті програма припиняє виконання, адже саме закриття першої форми впливає на те чи закриється програма, друга форма на це поки що не впливає)

С++ головного мозку
Розмовляю Українською, пишу С+плюсом

12

Re: Знімок з Веб-камери на Дельфі 7

1-ий модуль (робота з фото)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,  StdCtrls, ExtCtrls, directshow9, ActiveX, Jpeg, WinInet, IniFiles,
  ExtDlgs;


type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Panel1: TPanel;
    Button1: TButton;
    Panel2: TPanel;
    Button2: TButton;
    Button3: TButton;
    SavePictureDialog1: TSavePictureDialog;
    Edit1: TEdit;
    Edit2: TEdit;
    Image1: TImage;
    RadioButton1: TRadioButton;
    function CreateGraph: HResult;
    function Initializ: HResult;
    function CaptureBitmap: HResult;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  IniFile: TIniFile;
  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

uses Unit2;

{$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;

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);

      //помещаем изображение на canvas image1
      image1.Picture.Bitmap:=Bitmap;

    except

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

procedure TForm1.Button2Click(Sender: TObject);
begin
//проверяем если устройства для захвата изображения
if Listbox1.Count=0 then
    Begin
      ShowMessage('Увага! Камера не знайдена');
      Exit;
    End;
//Грабим кадр
if FAILED(CaptureBitmap) then
    Begin
      ShowMessage('Увага! Виникла помилка при отриманні зображення');
      Exit;
    End;
    edit1.Text:='Тепер ви можете зберегти фото у файл';
    edit1.Visible:=true;
    button3.Enabled:=true;
    edit2.Visible:=false;
end;

procedure TForm1.Button1Click(Sender: TObject);
//Вызов страницы свойств Web-камеры
var
  StreamConfig: IAMStreamConfig;
  PropertyPages: ISpecifyPropertyPages;
  Pages: CAUUID;
Begin
  // Если отсутствует интерфейс работы с видео, то завершаем работу
  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.FormCreate(Sender: TObject);
begin
//загружаем настройки из ini файла
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
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.Button3Click(Sender: TObject);
begin
if savepicturedialog1.execute then
image1.picture.savetofile(savepicturedialog1.FileName);
end;



procedure TForm1.RadioButton1Click(Sender: TObject);
begin
Application.CreateForm(TForm2,Form2);
form2.show;
end;

end.
С++ головного мозку
Розмовляю Українською, пишу С+плюсом

13 Востаннє редагувалося КиївОболонь (17.11.2015 19:38:42)

Re: Знімок з Веб-камери на Дельфі 7

2-ий модуль (робота з відео)

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, directshow9, ActiveX, jpeg;

type
  TForm2 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    Panel1: TPanel;
    Button2: TButton;
    ListBox2: TListBox;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    SaveDialog1: TSaveDialog;
    Panel2: TPanel;
    function CreateGraph: HResult;
    function Initializ: HResult;
//    function CaptureBitmap: HResult;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    function  DisplayPropertyFrame(Filter: IBaseFilter; Handle: THandle): HResult;
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure ListBox2DblClick(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  FileName:string; //имя файла для записи
  RecMode: Boolean = False; //флаг записи
  DeviceName:OleVariant;  //имя устройства
  PropertyName:IPropertyBag; //
  pDevEnum:ICreateDEvEnum; //перечислитель устройств
  pEnum:IEnumMoniker; //перечислитель моникеров
  pMoniker:IMoniker;

  MArray1,MArray2: 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 TForm2.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;

//Перечислитель устройств Audio
Result:=pDevEnum.CreateClassEnumerator(CLSID_AudioInputDeviceCategory, pEnum, 0);
if Result<>S_OK  then EXIT;
//Обнуляем массив в списке моникеров
setlength(MArray2,0);
//Пускаем массив по списку устройств
while (S_OK=pEnum.Next(1,pMoniker,Nil)) do
begin
setlength(MArray2,length(MArray2)+1); //Увеличиваем массив на единицу
MArray2[length(MArray2)-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;
//Добавляем имя устройства в списки
Listbox2.Items.Add(DeviceName);
end;
//Первоначальный выбор устройств для захвата видео и звука
//Выбираем из спика камеру
if ListBox1.Count=0 then
   begin
      ShowMessage('Камера не знайдена');
      Result:=E_FAIL;;
      Exit;
   end;
Listbox1.ItemIndex:=0;
//Выбираем из спика устройства для записи звука
if ListBox2.Count=0 then
    begin
      ShowMessage('Мікрофон не знайдений');
    end
                    else  Listbox2.ItemIndex:=0;

//если все ОК
Result:=S_OK;
end;

function TForm2.CreateGraph:HResult;
var
  pConfigMux: IConfigAviMux;
begin
//Чистим граф
  FAudioCaptureFilter  := NIL;
  FVideoCaptureFilter  := NIL;
  FVideoWindow         := NIL;
  FMediaControl        := NIL;
  FSink                := NIL;
  FMux                 := NIL;
  FCaptureGraphBuilder := NIL;
  FGraphBuilder        := NIL;

//Создаем объект для графа фильтров
Result:=CoCreateInstance(CLSID_FilterGraph, NIL, CLSCTX_INPROC_SERVER, IID_IGraphBuilder, FGraphBuilder);
if FAILED(Result) then EXIT;
//Создаем объект для графа захвата
Result:=CoCreateInstance(CLSID_CaptureGraphBuilder2, NIL, CLSCTX_INPROC_SERVER, IID_ICaptureGraphBuilder2, FCaptureGraphBuilder);
if FAILED(Result) then EXIT;
//Задаем граф фильтров
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;

//если выбрано устройство для захвата звука
if Listbox2.ItemIndex>=0 then
           begin
              //получаем устройство для захвата звука из списка моникеров
              MArray2[Listbox2.ItemIndex].BindToObject(NIL, NIL, IID_IBaseFilter, FAudioCaptureFilter);
              //добавляем устройство в граф фильтров
              FGraphBuilder.AddFilter(FAudioCaptureFilter, 'AudioCaptureFilter');
              //строим граф для вывода звука
              Result:=FCaptureGraphBuilder.RenderStream(@PIN_CATEGORY_PREVIEW, @MEDIATYPE_Audio,
              FAudioCaptureFilter, NIL, NIL);
              if FAILED(Result) then EXIT;
           end;

//строим граф для вывода изображения
Result:=FCaptureGraphBuilder.RenderStream(@PIN_CATEGORY_PREVIEW, @MEDIATYPE_Video, FVideoCaptureFilter, NIL, 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);

//Запись
if RecMode then
begin
//Создаем файл для записи данных из графа
Result:=FCaptureGraphBuilder.SetOutputFileName(MEDIASUBTYPE_Avi, PWideChar(FileName), FMux, FSink);
if FAILED(Result) then EXIT;

//строим граф фильтров для захвата изображения
Result:=FCaptureGraphBuilder.RenderStream(@PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video, FVideoCaptureFilter, Nil, FMux);
if FAILED(Result) then EXIT;


if Listbox2.ItemIndex>=0 then
    begin
        //строим граф фильтров для захвата звука
        Result:=FCaptureGraphBuilder.RenderStream(@PIN_CATEGORY_CAPTURE, @MEDIATYPE_Audio, FAudioCaptureFilter, Nil, FMux);
        if FAILED(Result) then EXIT;
        // При захвате видео со звуком устанавливаем звуковой поток в
        // качестве основного для синхронизации с другими потоками в файле
                pConfigMux := NIL;
                Result:=FMux.QueryInterface(IID_IConfigAviMux, pConfigMux);
                if FAILED(Result) then EXIT;
                begin
                  pConfigMux.SetMasterStream(1);
                  pConfigMux := NIL;
                end;
    end;
end;
//Запрашиваем интерфейс управления графом
Result:=FGraphBuilder.QueryInterface(IID_IMediaControl, FMediaControl);
if FAILED(Result) then Exit;
//Запускаем отображение просмотра с вебкамер
FMediaControl.Run();
//end;
  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;



//Запись с камеры в файл
procedure TForm2.Button1Click(Sender: TObject);
begin
//проверяем если устройства для захвата Video
if Listbox1.Count=0 then
    Begin
      ShowMessage('Камера не знайдена');
      Exit;
    End;
//если запись уже идет, то выходим
If RecMode then Exit;
//задаем текущий каталог для записи
SaveDialog1.InitialDir:=GetCurrentDir;
// Установка расширения по умолчанию
SaveDialog1.DefaultExt := 'avi';
if not (SaveDialog1.Execute) then  exit;
//получаем имя файла для записи
FileName:=SaveDialog1.FileName;
//устанавливаем флаг записи
RecMode:=True;
//вызываем процедуру построения графа фильтров
if FAILED(CreateGraph) then
    Begin
      ShowMessage('Виникла помилка при побудові графа фільтрів');
      RecMode:=False;
      Exit;
    End;
//Выводим на панель надпись
Panel2.Caption:='Йде запис відео';
end;

//Остановка записи и переход в режим просмотра
procedure TForm2.Button2Click(Sender: TObject);
begin
//если запись не идет, то выходим
If not(RecMode) then Exit;
// Останавливаем работу графа
FMediaControl.Stop;
//устанавливаем флаг записи
RecMode:=False;
//перестраиваем граф
if FAILED(CreateGraph) then
    Begin
      ShowMessage('Виникла помилка при побудові графа фільтрів');
      Exit;
    End;
Panel2.Caption:='Режим перегляду';
end;

procedure TForm2.Button3Click(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;



//Вызов страницы свойств заданного фильтра
function TForm2.DisplayPropertyFrame(Filter: IBaseFilter; Handle: THandle): HResult;
var
  PropertyPages: ISpecifyPropertyPages;
  Pages: CAUUID;
  FilterInfo: TFilterInfo;
  pfilterUnk: IUnknown;
begin
  // Результат по умолчанию
  Result := E_FAIL;

  // Если фильтр не определен, то завершаем работу
  if Filter = NIL then EXIT;

  // Пытаемся найти интерфейс управления страницами свойств фильтра
  Result := Filter.QueryInterface(ISpecifyPropertyPages, PropertyPages);

  if (SUCCEEDED(Result)) then
  begin
    // Получение имени фильтра и указателя на интерфейс IUnknown
    Filter.QueryFilterInfo(FilterInfo);
    Filter.QueryInterface(IUnknown, pfilterUnk);

    // Получаем массив страниц свойств
    PropertyPages.GetPages(Pages);
    PropertyPages := NIL;

    // Отображаем страницу свойств в виде модального диалога
    OleCreatePropertyFrame(
       Handle,
       0,
       0,
       FilterInfo.achName,
       1,
       @pfilterUnk,
       Pages.cElems,
       Pages.pElems,
       0,
       0,
       NIL
    );

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

end;

//Вызов страницы свойств устройства работы с видео
procedure TForm2.Button4Click(Sender: TObject);
begin
If RecMode then Exit;
DisplayPropertyFrame(FVideoCaptureFilter, Handle);
end;

//Вызов страницы свойств устройства работы со звуком
procedure TForm2.Button5Click(Sender: TObject);
begin
If RecMode then Exit;
DisplayPropertyFrame(FAudioCaptureFilter, Handle);
end;


procedure TForm2.FormCreate(Sender: TObject);
begin
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;
        Panel2.Caption:='Режим перегляду';
    end else
            Begin
              ShowMessage('Камери не знайдено');
              //Application.Terminate;
            End;
end;

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


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

//Выбор устройств из ListBox2
procedure TForm2.ListBox2DblClick(Sender: TObject);
begin
if ListBox1.Count>0 then
    begin
    //перестраиваем граф при смене устройства захвата звука
      if FAILED(CreateGraph) then
            Begin
              ShowMessage('Виникла помилка при побудові графа фільтрів');
              Exit;
            End;
Panel2.Caption:='Режим перегляду';
     end else
            Begin
               ShowMessage('Не вибрана камера');
               Exit;
            End;
end;


end.


Перехід від першої до другої форми під час виконання програми здійснюється через radiobutton, а друга форма вже замість чорної панелі просто не робоча (тобто при переході на неї не можна виводити зображення з камери чи вести запис відео)

С++ головного мозку
Розмовляю Українською, пишу С+плюсом

14

Re: Знімок з Веб-камери на Дельфі 7

Спробуйте перед показом другої форми викликати код з TForm1.FormDestroy. А перед поверненням назад на першу - TForm1.FormCreate. Для другої форми аналогічно.

15

Re: Знімок з Веб-камери на Дельфі 7

Добре, дякую. А як відключити програмно камеру від програми на деякий час?
Де можна зробити форму основною?

С++ головного мозку
Розмовляю Українською, пишу С+плюсом

16

Re: Знімок з Веб-камери на Дельфі 7

Наскільки я зрозумів код, відключення вебки відбувається в TFormХ.FormDestroy.

КиївОболонь написав:

Де можна зробити форму основною?

У властивостях проекту є список форм. Там є можливість вибрати основну. Хоча по суті це просто змінить порядок створення форм у dpr-файлі. Перша створена форма стає основною.

17

Re: Знімок з Веб-камери на Дельфі 7

А як відключити програмно камеру від програми на деякий час?

зруйнувати граф.

Там де він будується - спочатку йде його очищення, коментар невірний, йде звільнення об'єктів інтерфейсів і декомпозиція графа.

Білоруський журнал «Радиолюбитель»
Lead Radar systems engineer & Software developer of industrial automation
Мої розробки та відеоблог

18

Re: Знімок з Веб-камери на Дельфі 7

Torbins написав:

Наскільки я зрозумів код, відключення вебки відбувається в TFormХ.FormDestroy.

КиївОболонь написав:

Де можна зробити форму основною?

У властивостях проекту є список форм. Там є можливість вибрати основну. Хоча по суті це просто змінить порядок створення форм у dpr-файлі. Перша створена форма стає основною.

О, дякую

С++ головного мозку
Розмовляю Українською, пишу С+плюсом

19

Re: Знімок з Веб-камери на Дельфі 7

raxp написав:

А як відключити програмно камеру від програми на деякий час?

зруйнувати граф.

Там де він будується - спочатку йде його очищення, коментар невірний, йде звільнення об'єктів інтерфейсів і декомпозиція графа.

Це щось на зразок створити функцію cleargraph і викликати її при натисненні на Радіобатон?

С++ головного мозку
Розмовляю Українською, пишу С+плюсом

20

Re: Знімок з Веб-камери на Дельфі 7

А якщо зробити третю форму, яка буде головною? На ній буде 2 батони-для переходу на форму1 або на форму2. І тобто, якщо буде вибрана форма2, то і те що в 1-ій формі- будуватися не буде. Тільки як це реалізувати? Просто form.show не підходить(бо 2-а форма неробоча), а destroy попередньої форми при цьому теж не допомагає

С++ головного мозку
Розмовляю Українською, пишу С+плюсом