VPF::DirectShow: Video->BitMap - Форум программистов

JnK

Дата 18.2.2010, 19:30 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 11
Регистрация: 24.3.2007

Репутация: нет
Всего: нет

Всем привет!
Возникла такая проблема, нужно снимать скрины с видео файлов (avi, mkv, mp4, mov) ,
мучаюсь уже больше недели, но проблему решать так и не могу, заключается она в том, что не все видео файлы хотят отдавать картинку, вместо нее выводится черное изображение, есть видео когда выводится всегда одна и таже картинка не важно какое время я брал, кто может подсказать как это можно исправить?

Код


uses DirectShow9, ActiveX;

function VideoShot(FileName : String; var Image:HBITMAP; time:Double=4):Longint;
Var
 dsMediaDet      : IMediaDet;
 dsMediaStreams  : Integer;
 dsMediaLength   : Double;

 buffer:array of byte;
 buffsize:longint;
 initinfo:TBITMAPINFO;
 infoheader:TBITMAPINFOHEADER;
 hdcDest:HDC;

 height, width:word;
 info:_AMMediaType;

 hr              : HRESULT;

begin
 result:=0;
 BuffSize:=0;

 hr := CoCreateInstance(CLSID_MediaDet, nil, CLSCTX_INPROC, IID_IMediaDet, dsMediaDet);
 if hr <> S_OK then begin
    Showmessage('Media Detector not available');
   exit;
 end;

 hr := dsMediaDet.put_Filename(FileName);
 if hr <> S_OK then begin
   dsMediaDet := nil;
   exit;
 end;

 dsMediaDet.get_OutputStreams(dsMediaStreams);
 if dsMediaStreams > 0 then Begin
   dsMediaDet.put_CurrentStream(0);
   if dsMediaDet.get_StreamLength(dsMediaLength) = S_OK then
   result:=Round(dsMediaLength);

  dsMediaDet.get_StreamMediaType(info);
  Width:=VIDEOINFOHEADER(info.pbFormat^).bmiHeader.biWidth;
  Height:=VIDEOINFOHEADER(info.pbFormat^).bmiHeader.biHeight;
 hr := dsMediaDet.GetBitmapBits(time, @BuffSize, nil, Width, Height);
 if hr <> S_OK then begin
   dsMediaDet := nil;
   exit;
 end;
  SetLength(Buffer, BuffSize);
 hr := dsMediaDet.GetBitmapBits(time, nil, @Buffer[0], Width, Height);
 if hr <> S_OK then begin
   dsMediaDet := nil;
   exit;
 end;
  ZeroMemory(@InitInfo,  SizeOf(TBITMAPINFO));
  CopyMemory(@InfoHeader, @Buffer[0], SizeOf(TBITMAPINFOHEADER));
  CopyMemory(@InitInfo.bmiHeader, @InfoHeader, SizeOf(TBITMAPINFOHEADER));
  hdcDest := GetDC(0);
  Image := CreateDIBitmap(hdcDest, InfoHeader, CBM_INIT, @Buffer[SizeOf(TBITMAPINFOHEADER)], InitInfo, DIB_RGB_COLORS);
  end;
 dsMediaDet := nil;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  m:HBitmap;
  len:integer;
begin
  if not OV1.Execute then exit;
  len:=VideoShot(OV1.FileName,m,140);
  label1.Caption:='Time: '+inttostr(len);
  image1.Picture.Bitmap.Handle:=m;
  label1.Caption:=label1.Caption+#13#10+'Size: '+inttostr(image1.Width)+'x'+inttostr(image1.Height);
end;

P.s. Другие программы типа: Image Grabber снимают нормально.

Это сообщение отредактировал(а) JnK - 18.2.2010, 19:32

Bitter

Дата 22.2.2010, 18:59 (ссылка)

(нет голосов)

Загрузка ...

Опытный лентяй

Профиль
Группа: Завсегдатай
Сообщений: 1209
Регистрация: 15.8.2004
Где: Харьков, Ukraine

Репутация: 6
Всего: 27

Я не очень хорошо разбираюсь в DirectShow, я попробовал твой код на двух видео AVI и MPEG, работает хорошо.

Еще у интерфейса IMediaDet есть метод GetSampleGrabber, возвращающий интерфейс ISampleGrabber. А уже в нём есть метод GetCurrentBuffer, возвращающий текущий буфер и GetCurrentSample, возвращающий интерфейс IMediaSample. Может из них получится что-то вытащить? Я не пробовал.

RomanEEP

Дата 23.2.2010, 20:56 (ссылка)

(голосов:1)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 424
Регистрация: 18.5.2006
Где: Коломна

Репутация: 1
Всего: 8

Долго сам с этим мучался и родил такой код. Смысл в том что для воспроизведения видеофайла нужно создать граф, который создается из фильтров. Фильтр - это некий интерфейс который может кодировать, декодировать и воспроизводить видео/аудио. Граф - это правильно подобраный набор фильтров для воспроизведения определенного потока и соорудить его самому очень сложная задача. Но есть у DirectShow функция RenderFile которая создает граф для вывода в собственное небольшое окно, я это окно удаляю и на его место ставлю свой граббер

Это данные:

Код


   // DirectShow interfaces
    FGraphBuilder: ICaptureGraphBuilder2;
    FFilterGraph: IFilterGraph2;
    FSampleGrabber: ISampleGrabber;
    FMediaPosition: IMediaPosition;
    FBasicAudio: IBasicAudio;

    //video frame
    FAVIWidth: integer;
    FAVIHeight: integer;
    FFrameBitmapInfoHeader: TBitmapInfoHeader;
    FFrameData: TImageData;

    //Bitmap, в который перемещаются кадры видео
    FAVIBitmap: HBITMAP;
    FAVIBitmapDC: HDC;
    FAVIDIBData: Pointer;
    FAVIDrawDib: HDRAWDIB;

Открытие видеофайла и создание графа

Код



  procedure Check(Res: HResult);
  begin
    if (Res <> S_OK) and (Res <> VFW_S_PARTIAL_RENDER) then
      raise EDirectShowError.Create(Res);
  end;

  procedure FindPin(baseFilter: IBaseFilter;
                   direction: PIN_DIRECTION;
                   pinNumber: Integer;
                   out destPin: IPin);
  var
    enumPins: IEnumPins;
    numFound: Cardinal;
    tmpPin: IPin;
    pinDirection: PIN_DIRECTION;
  begin
    destPin := nil;

    if baseFilter.EnumPins(enumPins) = S_OK then
    begin
      while enumPins.Next(1, tmpPin, @numFound) = S_OK do
      begin
          tmpPin.QueryDirection(pinDirection);
          if pinDirection = direction then
          begin
              if pinNumber = 0 then
              begin
                  // Return the pin's interface
                  destPin := tmpPin;
                  break;
              end
              else
                DestPin := nil;
              Dec(pinNumber);
          end;
          tmpPin := nil;
      end;
    end;
  end;

  function ConnectPins(outputFilter: IBaseFilter;
                       outputNum: Cardinal;
                       inputFilter: IBaseFilter;
                       inputNum: Cardinal): boolean;
  var
    inputPin, outputPin: IPin;
  begin
    if (outputFilter = nil) or (inputFilter = nil) then
    begin
      Result := False;
      Exit;
    end;

    FindPin(outputFilter, PINDIR_OUTPUT, outputNum, outputPin);
    FindPin(inputFilter, PINDIR_INPUT, inputNum, inputPin);
    if (outputPin = nil) or (InputPin = nil) then
      Check(-1);
     Check(FFilterGraph.Connect(outputPin, inputPin));
     Result := True;
  end;

const
  MaxGraphRunAttempts = 100;

var
  bmi: BITMAPINFO;
  BitmapHeader: BITMAPINFOHEADER;
  WideStr: WideString;
  RunGraphAttempts: Integer;

  grabberFilter, nullRenderer: IBaseFilter;
  desiredType, connectedType: AM_MEDIA_TYPE;
  infoHeader: VIDEOINFOHEADER;
  mediaControl: IMediaControl;
  pfs: _FilterState;
  BufSize: Integer;

  OutputPin, inputPin: IPin;

  EnumFilters: IEnumFilters;
  VideoRenderer, TmpFilter: IBaseFilter;
  TmpGUID: TGUID;
begin
  CheckOpenGLError;
  AVIClose;
  Result := False;
  try
    // Create the main object that runs the graph
    Check(CoCreateInstance(CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC_SERVER,
    IID_ICaptureGraphBuilder2, FGraphBuilder));

    //create filter graph
    Check(CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC_SERVER,
      IID_IFilterGraph, FFilterGraph));

    //convert file name to unicode
    WideStr := Path;
    //render whole graph
    Check(FFilterGraph.RenderFile(PWideChar(WideStr), nil));

    //seeking for default renderer window
    VideoRenderer := nil;
    FFilterGraph.EnumFilters(EnumFilters);
    while EnumFilters.Next(1, TmpFilter, @BufSize) = S_OK do
    begin
      if TmpFilter.GetClassID(TmpGUID) = S_OK then
      begin
        if IsEqualGUID(TmpGUID, CLSID_VideoMixingRenderer) or
          IsEqualGUID(TmpGUID, CLSID_VideoRendererDefault) then
        begin
          VideoRenderer := TmpFilter;
          break;
        end;
      end;
    end;

    if VideoRenderer = nil then
      raise EDirectShowError.Create('No video decoders found');

    //find video output pin and disconnect default video renderer
    FindPin(VideoRenderer, PINDIR_INPUT, 0, inputPin);
    Check(inputPin.ConnectedTo(OutputPin));
    FFilterGraph.RemoveFilter(VideoRenderer);

    // Create the Sample Grabber to take frames
    Check(CoCreateInstance(CLSID_SampleGrabber, nil, CLSCTX_INPROC_SERVER,
      IID_IBaseFilter, GrabberFilter));
    Check(grabberFilter.QueryInterface(IID_ISampleGrabber, FSampleGrabber));
    Check(FFilterGraph.AddFilter(grabberFilter, 'Sample Grabber'));

    // Set the 24-bit RGB desire here
    // So that the proper conversion filters
    // Are added automatically.
    FillMemory(@DesiredType, Sizeof(desiredType), 0);
    desiredType.majortype := MEDIATYPE_Video;
    desiredType.subtype := MEDIASUBTYPE_RGB24;
    desiredType.formattype := FORMAT_VideoInfo;

    Check(FSampleGrabber.SetMediaType(desiredType));
    Check(FSampleGrabber.SetBufferSamples(TRUE));

    //connect grabber to video output
    FindPin(grabberFilter, PINDIR_INPUT, 0, inputPin);
    Check(FFilterGraph.Connect(OutputPin, inputPin));

    // A Null Renderer does not display the video
    // But it allows the Sample Grabber to run
    // And it will keep proper playback timing
    // Unless specified otherwise.
    Check(CoCreateInstance(CLSID_NullRenderer, nil, CLSCTX_INPROC_SERVER,
      IID_IBaseFilter, nullRenderer));

    Check(FFilterGraph.AddFilter(nullRenderer, 'New Null Renderer'));
    ConnectPins(grabberFilter, 0, nullRenderer, 0);

    // video resolution
    Check(FSampleGrabber.GetConnectedMediaType(connectedType));

    if not IsEqualGUID(connectedType.formattype, FORMAT_VideoInfo) then
      raise EDirectShowError.Create('Can not get video info');

    infoHeader := VIDEOINFOHEADER(connectedType.pbFormat^);
    FAVIWidth := infoHeader.bmiHeader.biWidth;
    FAVIHeight := infoHeader.bmiHeader.biHeight;
    FAVIGLWidth := RoundUpToPowerOf2(FAVIWidth, MaxAVIResolution);
    FAVIGLHeight := RoundUpToPowerOf2(FAVIHeight, MaxAVIResolution);
    FFrameBitmapInfoHeader := infoHeader.bmiHeader;
    CoTaskMemFree(connectedType.pbFormat);


    Check(FFilterGraph.QueryInterface(IID_IMediaControl, MediaControl));

     // Tell the whole graph to start sending video
    if mediaControl.Run <> S_OK then
    begin
      RunGraphAttempts := 0;
      while mediaControl.GetState(100, pfs) <> S_OK do
      begin
        sleep(100);
        Inc(RunGraphAttempts);
        if RunGraphAttempts > MaxGraphRunAttempts then
          raise EdirectShowError.Create('Can not play graph');
      end;
    end;
    Check(FFilterGraph.QueryInterface(IID_IMediaPosition, FMediaPosition));
    Check(FFilterGraph.QueryInterface(IID_IBasicAudio, FBasicAudio));

    FAVIDrawDib := DrawDibOpen;
    ZeroMemory(@bmi, SizeOf(bmi));
    ZeroMemory(@BitmapHeader, SizeOf(BitmapHeader));
    with bmi.bmiHeader do
    begin
      biSize := sizeof(BITMAPINFOHEADER);
      biPlanes := 1;
      biBitCount := 24;
      biWidth := FAVIGLWidth;
      biHeight := FAVIGLHeight;
      biCompression := BI_RGB;
    end;
    FAVIBitmapDC := CreateCompatibleDC(0);
    FAVIBitmap := CreateDIBSection(FAVIBitmapDC,bmi,DIB_RGB_COLORS,FAVIDIBData,0,0);
    SelectObject(FAVIBitmapDC,FAVIBitmap);
    SetLength(FAVIGLData, FAVIGLWidth * FAVIGLHeight * 3);
    FAviOpen := True;
    FAviUpdateTime := 0;
    Result := True;
  except
    on EDirectShowError do
      AviClose;
  end;
end;

Так получать декодированный кадр:

Код


  FSampleGrabber.GetCurrentBuffer(DibDataSize, nil);
  SetLength(FFrameData, DibDataSize);
  ErrCode := FSampleGrabber.GetCurrentBuffer(DibDatasize, FFrameData);

--------------------

Электронные экзамены

Bitter

Дата 24.2.2010, 12:14 (ссылка)

(нет голосов)

Загрузка ...

Опытный лентяй

Профиль
Группа: Завсегдатай
Сообщений: 1209
Регистрация: 15.8.2004
Где: Харьков, Ukraine

Репутация: 6
Всего: 27

RomanEEP, а не могли бы вы выложить пример целиком, с выводом кадра в TBitmap? Был бы очень благодарен

RomanEEP

Дата 24.2.2010, 22:33 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 424
Регистрация: 18.5.2006
Где: Коломна

Репутация: 1
Всего: 8

Это часть большого проекта. Я отобрал кусок отвечающий за видео и для примера тут больше ничего не нужно - можешь смело скопировать код куда нибуть в батонадинклик и усё будет работать, только лишние переменные поудалять надо.

--------------------

Электронные экзамены

Bitter

Дата 25.2.2010, 20:22 (ссылка)

(нет голосов)

Загрузка ...

Опытный лентяй

Профиль
Группа: Завсегдатай
Сообщений: 1209
Регистрация: 15.8.2004
Где: Харьков, Ukraine

Репутация: 6
Всего: 27

а что такое TImageData? и как потом из него достать Bitmap?

JnK

Дата 25.2.2010, 20:25 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 11
Регистрация: 24.3.2007

Репутация: нет
Всего: нет

Не получается правильно собрать программу. :(
Добился только: Открываются файлы только Avi (идет звук, и видно загруженные кодеки), у других форматов - ничего не происходит. :(

Добавлено @ 20:30

Цитата(Bitter @ 25.2.2010, 20:22)

а что такое TImageData? и как потом из него достать Bitmap?

TImageData - Как я понял это от библиотеки OpenGL.
На все что ругается компилятор комментируй, кроме

Код


 raise EdirectShowError.Create(...);

это заменяй на

Код

begin
  ShowMessage('...');
  exit;
end;

или

Код


raise Exception.Create('...');

Это сообщение отредактировал(а) JnK - 25.2.2010, 20:37

RomanEEP

Дата 25.2.2010, 21:10 (ссылка)

(голосов:1)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 424
Регистрация: 18.5.2006
Где: Коломна

Репутация: 1
Всего: 8

TImageData = array of Byte; В Bitmap можешь засунуть так:

Код


  Bitmap := TBitmap.Create;
  Bitmap.PixelFormat ;= pf24bit;
  Bitmap.Width := FAVIWidth;
  Bitmap.Height := FAVIHeight;
  FSampleGrabber.GetCurrentBuffer(DibDataSize, nil);
  Assert(DibDataSize = FAVIWidth * FAVIHEight * 3);
  ErrCode := FSampleGrabber.GetCurrentBuffer(DibDataSize, Bitmap.ScanLine[0]);

--------------------

Электронные экзамены

JnK

Дата 28.2.2010, 03:38 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 11
Регистрация: 24.3.2007

Репутация: нет
Всего: нет

Не получается
Вешаю код BitMap на 2 батон в итоге вылетает с ошибкой, чтения участка памяти, по эксперементировав, получил, что иногда выдает черный квадрат.
Кроме Avi так и не смог заставить воспроизвести.

Это сообщение отредактировал(а) JnK - 28.2.2010, 03:42

RomanEEP

Дата 28.2.2010, 20:28 (ссылка)

(голосов:2)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 424
Регистрация: 18.5.2006
Где: Коломна

Репутация: 1
Всего: 8

Код


unit Unit3;

interface

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

type
  TForm3 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    FGraphBuilder: ICaptureGraphBuilder2;
    FFilterGraph: IFilterGraph2;
    FSampleGrabber: ISampleGrabber;
    FMediaPosition: IMediaPosition;
    FBasicAudio: IBasicAudio;

    //video frame
    FAVIWidth: integer;
    FAVIHeight: integer;
    FFrameBitmapInfoHeader: TBitmapInfoHeader;
    FFrameData: array of byte;

    //Bitmap, в который перемещаются кадры видео
    FAVIBitmap: HBITMAP;
    FAVIBitmapDC: HDC;
    FAVIDIBData: Pointer;
    //FAVIDrawDib: HDRAWDIB;
  public
    { Public declarations }
    procedure OpenFile(Path: string);
  end;

var
  Form3: TForm3;

implementation

uses
  ActiveX;

{$R *.dfm}

procedure TForm3.Button1Click(Sender: TObject);
begin
  OpenFile('e:\VIDEO\delivery.wmv');
  Timer1.Enabled := True;
end;

procedure TForm3.OpenFile(Path: string);

  procedure Check(Res: HResult);
  begin
    if (Res <> S_OK) and (Res <> VFW_S_PARTIAL_RENDER) then
      raise Exception.Create(IntToStr(Res));
  end;

  procedure FindPin(baseFilter: IBaseFilter;
                   direction: PIN_DIRECTION;
                   pinNumber: Integer;
                   out destPin: IPin);
  var
    enumPins: IEnumPins;
    numFound: Cardinal;
    tmpPin: IPin;
    pinDirection: PIN_DIRECTION;
  begin
    destPin := nil;

    if baseFilter.EnumPins(enumPins) = S_OK then
    begin
      while enumPins.Next(1, tmpPin, @numFound) = S_OK do
      begin
          tmpPin.QueryDirection(pinDirection);
          if pinDirection = direction then
          begin
              if pinNumber = 0 then
              begin
                  // Return the pin's interface
                  destPin := tmpPin;
                  break;
              end
              else
                DestPin := nil;
              Dec(pinNumber);
          end;
          tmpPin := nil;
      end;
    end;
  end;

  function ConnectPins(outputFilter: IBaseFilter;
                       outputNum: Cardinal;
                       inputFilter: IBaseFilter;
                       inputNum: Cardinal): boolean;
  var
    inputPin, outputPin: IPin;
  begin
    if (outputFilter = nil) or (inputFilter = nil) then
    begin
      Result := False;
      Exit;
    end;

    FindPin(outputFilter, PINDIR_OUTPUT, outputNum, outputPin);
    FindPin(inputFilter, PINDIR_INPUT, inputNum, inputPin);
    if (outputPin = nil) or (InputPin = nil) then
      Check(-1);
     Check(FFilterGraph.Connect(outputPin, inputPin));
     Result := True;
  end;

const
  MaxGraphRunAttempts = 100;

var
  bmi: BITMAPINFO;
  BitmapHeader: BITMAPINFOHEADER;
  WideStr: WideString;
  RunGraphAttempts: Integer;

  grabberFilter, nullRenderer: IBaseFilter;
  desiredType, connectedType: AM_MEDIA_TYPE;
  infoHeader: VIDEOINFOHEADER;
  mediaControl: IMediaControl;
  pfs: _FilterState;
  BufSize: Integer;

  OutputPin, inputPin: IPin;

  EnumFilters: IEnumFilters;
  VideoRenderer, TmpFilter: IBaseFilter;
  TmpGUID: TGUID;
begin
  // Create the main object that runs the graph
  Check(CoCreateInstance(CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC_SERVER,
  IID_ICaptureGraphBuilder2, FGraphBuilder));

  //create filter graph
  Check(CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC_SERVER,
    IID_IFilterGraph, FFilterGraph));

  //convert file name to unicode
  WideStr := Path;
  //render whole graph
  Check(FFilterGraph.RenderFile(PWideChar(WideStr), nil));

  //seeking for default renderer window
  VideoRenderer := nil;
  FFilterGraph.EnumFilters(EnumFilters);
  while EnumFilters.Next(1, TmpFilter, @BufSize) = S_OK do
  begin
    if TmpFilter.GetClassID(TmpGUID) = S_OK then
    begin
      if IsEqualGUID(TmpGUID, CLSID_VideoMixingRenderer) or
        IsEqualGUID(TmpGUID, CLSID_VideoRendererDefault) then
      begin
        VideoRenderer := TmpFilter;
        break;
      end;
    end;
  end;

  if VideoRenderer = nil then
    raise Exception.Create('No video decoders found');

  //find video output pin and disconnect default video renderer
  FindPin(VideoRenderer, PINDIR_INPUT, 0, inputPin);
  Check(inputPin.ConnectedTo(OutputPin));
  FFilterGraph.RemoveFilter(VideoRenderer);

  // Create the Sample Grabber to take frames
  Check(CoCreateInstance(CLSID_SampleGrabber, nil, CLSCTX_INPROC_SERVER,
    IID_IBaseFilter, GrabberFilter));
  Check(grabberFilter.QueryInterface(IID_ISampleGrabber, FSampleGrabber));
  Check(FFilterGraph.AddFilter(grabberFilter, 'Sample Grabber'));

  // Set the 24-bit RGB desire here
  // So that the proper conversion filters
  // Are added automatically.
  FillMemory(@DesiredType, Sizeof(desiredType), 0);
  desiredType.majortype := MEDIATYPE_Video;
  desiredType.subtype := MEDIASUBTYPE_RGB24;
  desiredType.formattype := FORMAT_VideoInfo;

  Check(FSampleGrabber.SetMediaType(desiredType));
  Check(FSampleGrabber.SetBufferSamples(TRUE));

  //connect grabber to video output
  FindPin(grabberFilter, PINDIR_INPUT, 0, inputPin);
  Check(FFilterGraph.Connect(OutputPin, inputPin));

  // A Null Renderer does not display the video
  // But it allows the Sample Grabber to run
  // And it will keep proper playback timing
  // Unless specified otherwise.
  Check(CoCreateInstance(CLSID_NullRenderer, nil, CLSCTX_INPROC_SERVER,
    IID_IBaseFilter, nullRenderer));

  Check(FFilterGraph.AddFilter(nullRenderer, 'New Null Renderer'));
  ConnectPins(grabberFilter, 0, nullRenderer, 0);

  // video resolution
  Check(FSampleGrabber.GetConnectedMediaType(connectedType));

  if not IsEqualGUID(connectedType.formattype, FORMAT_VideoInfo) then
    raise Exception.Create('Can not get video info');

  infoHeader := VIDEOINFOHEADER(connectedType.pbFormat^);
  FAVIWidth := infoHeader.bmiHeader.biWidth;
  FAVIHeight := infoHeader.bmiHeader.biHeight;
  FFrameBitmapInfoHeader := infoHeader.bmiHeader;
  CoTaskMemFree(connectedType.pbFormat);


  Check(FFilterGraph.QueryInterface(IID_IMediaControl, MediaControl));

   // Tell the whole graph to start sending video
  if mediaControl.Run <> S_OK then
  begin
    RunGraphAttempts := 0;
    while mediaControl.GetState(100, pfs) <> S_OK do
    begin
      sleep(100);
      Inc(RunGraphAttempts);
      if RunGraphAttempts > MaxGraphRunAttempts then
        raise Exception.Create('Can not play graph');
    end;
  end;

  ZeroMemory(@bmi, SizeOf(bmi));
  ZeroMemory(@BitmapHeader, SizeOf(BitmapHeader));
  with bmi.bmiHeader do
  begin
    biSize := sizeof(BITMAPINFOHEADER);
    biPlanes := 1;
    biBitCount := 24;
    biWidth := FAVIWidth;
    biHeight := FAVIHeight;
    biCompression := BI_RGB;
  end;
  FAVIBitmapDC := CreateCompatibleDC(0);
  FAVIBitmap := CreateDIBSection(FAVIBitmapDC,bmi,DIB_RGB_COLORS,FAVIDIBData,0,0);
  SelectObject(FAVIBitmapDC,FAVIBitmap);
end;

procedure TForm3.Timer1Timer(Sender: TObject);
var
  ErrCode, DibDataSize: Integer;
begin
  if FSampleGrabber = nil then Exit;
  FSampleGrabber.GetCurrentBuffer(DibDataSize, nil);
  Assert(DibDataSize = FAVIWidth * FAVIHEight * 3);
  ErrCode := FSampleGrabber.GetCurrentBuffer(DibDataSize, FAVIDIBData);
  StretchBlt(Canvas.Handle, 50, 50, 500, 280,
          FAVIBitmapDC, 0, 0, FAVIWidth,
          FAVIHeight, SRCCOPY);
end;

end.

--------------------

Электронные экзамены

JnK

Дата 1.3.2010, 00:57 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 11
Регистрация: 24.3.2007

Репутация: нет
Всего: нет

Спасибо за код.
Проблемка осталась с кодеками вроде, на некоторых файлах вылетает ошибка -2147220969, в частности на mkv (matroska). smile

Bitter

Дата 1.3.2010, 22:21 (ссылка)

(нет голосов)

Загрузка ...

Опытный лентяй

Профиль
Группа: Завсегдатай
Сообщений: 1209
Регистрация: 15.8.2004
Где: Харьков, Ukraine

Репутация: 6
Всего: 27

Вот так мужик (я про RomanEEP), а говорят не осталось героев... Спасибо

zero7

Дата 3.11.2011, 10:38 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 3
Регистрация: 3.11.2011

Репутация: нет
Всего: нет

имеется avi файл. при воспроизведении на vlc playre показывает copy protected video file.
при замене всех Akks на 00dc вначале проигрывания надпись остается, но появляется видео.
однако видео какое-то несмотрибельное. что делать? могу прислать файл 11 метров.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »