Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Delphi > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Ответ
 
Опции темы
Старый 21.04.2017, 10:56   #11
Aliens_wolfs
Участник клуба
 
Регистрация: 16.12.2009
Адрес: WWW ЛЕНИНГРАД СПб точка РУ
Сообщений: 860
Репутация: 435
По умолчанию

Вот весь код без лишнего потока видео в pVideoWindow.put_Owner(pnl1.Handle) ;

callback можно использовать тот что выше код
Код:

function GetPin(pFilter: IBaseFilter; PintDir: TPinDirection): IPin;
var
  bFound: Boolean;
  pEnum: IEnumPins;
  pPin: IPin;
  hr: HRESULT;
  PinDirThis: TPinDirection;
begin
  Result := NIL;
  bFound := False;

  hr := pFilter.EnumPins(pEnum);
  if Failed(hr) then
    Exit;

  while (pEnum.Next(1, pPin, NIL) = S_OK) do
  begin
    pPin.QueryDirection(PinDirThis);
    bFound := (PintDir = PinDirThis);
    if bFound then
      Break;
    pPin := NIL;
  end;

  pEnum := NIL;
  if bFound then
    Result := pPin;
end;

procedure RemoveDefault(pGraph: IGraphBuilder; pNULLRenderer, pGrabberBase: IBaseFilter);
var
  pVidRenderer, pColorConverter: IBaseFilter;
  Pin, oPin: IPin;
begin
  pGraph.FindFilterByName('Video Renderer', pVidRenderer);
  if (pVidRenderer <> NIL) then
  begin
    Pin := GetPin(pVidRenderer, PINDIR_INPUT);
    oPin := NIL;
    Pin.ConnectedTo(oPin);
    Pin.Disconnect;
    oPin.Disconnect;
    Pin := NIL;

    pGraph.RemoveFilter(pVidRenderer);
    pVidRenderer := NIL;

    pGraph.FindFilterByName('Color Space Converter', pColorConverter);
    if (pColorConverter <> NIL) then
    begin
      oPin := NIL;
      Pin := GetPin(pColorConverter, PINDIR_INPUT);
      Pin.ConnectedTo(oPin);
      Pin.Disconnect;
      oPin.Disconnect;
      Pin := NIL;

      pGraph.RemoveFilter(pColorConverter);
      pColorConverter := NIL;
    end;

    Pin := GetPin(pGrabberBase, PINDIR_INPUT);
    pGraph.Connect(oPin, Pin);
    Pin := NIL;
    oPin := NIL;

    oPin := GetPin(pGrabberBase, PINDIR_OUTPUT);
    Pin := GetPin(pNULLRenderer, PINDIR_INPUT);

    pGraph.Connect(oPin, Pin);
    Pin := NIL;
    oPin := NIL;
  end;
end;

procedure TForm1.ClearGraph;
begin
  if Assigned(pMediaControl) then
  pMediaControl.Stop;
  pVideoGrabber := nil;
  pMediaControl := nil;
  pGraphBuilder := nil;
end;

function TForm1.Play(FileName: String): HRESULT;
var
  MediaType: TAMMediaType;
begin
try
  Result:= CoCreateInstance(CLSID_FilterGraph, NIL, CLSCTX_INPROC_SERVER, IID_IGraphBuilder, pGraphBuilder);
   if Result <> S_OK then
  exit;

  Result:= pGraphBuilder.RenderFile(PWCHAR(WideString(FileName)), NIL);
   if Result <> S_OK then
  exit;

  Result:= CoCreateInstance(CLSID_SampleGrabber, NIL, CLSCTX_INPROC_SERVER, IID_IBaseFilter, pFilterSampleGrabber);
  pFilterSampleGrabber.QueryInterface(IID_ISampleGrabber, pVideoGrabber);
   if Result <> S_OK then
  exit;

  FillChar(MediaType, SizeOf(MediaType), 0);
  MediaType.majortype := MEDIATYPE_Video;
  MediaType.subtype := MEDIASUBTYPE_RGB24;
  pVideoGrabber.SetMediaType(MediaType);
  pVideoGrabber.SetBufferSamples(True);
  pVideoGrabber.SetOneShot(False);
  pVideoGrabber.SetCallback(Self, 0);
  pGraphBuilder.AddFilter(pFilterSampleGrabber, 'Sample Grabber');

 // это и есть NullRenderer чтобы работать без pVideoWindowа чисто на ресурсах callback
 Result:= CoCreateInstance(CLSID_NullRenderer, NIL, CLSCTX_INPROC_SERVER, IID_IBaseFilter, pNullRenderer);
  pGraphBuilder.AddFilter(pNullRenderer, 'Null Renderer');
  if Result <> S_OK then
  exit;
  RemoveDefault(pGraphBuilder, pNullRenderer, pFilterSampleGrabber);

  pGraphBuilder.QueryInterface(IID_IMediaControl, pMediaControl);
  pGraphBuilder.QueryInterface(IID_IMediaPosition, pMediaPosition);

  pMediaPosition.put_CurrentPosition(0);
  pMediaControl.Run;

 finally
 if Result <> S_OK then
  ClearGraph;
  end;
end;

Видео всё воспроизводит

Последний раз редактировалось Aliens_wolfs; 21.04.2017 в 11:40.
Aliens_wolfs вне форума   Ответить с цитированием
Старый 21.04.2017, 11:19   #12
BLACK_RAIN
Участник клуба
 
Регистрация: 13.02.2012
Сообщений: 512
Репутация: 119
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
Да и код я дописал по этой основе callback
Принципиальных отличий от своего кода я не вижу. Я переписал проект на WinAPI. Решилась проблема с отжором памяти. Пропали зависания и ошибки. Но всё-равно отрисовка тормозит на тяжёлых HD видео. Хотя процессор загружен только на 40%.
Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
Просто нужно правильно описать NullRenderer примерно так
ну так про NullRenderer я и говорил. Я знаю как его подключать. Только это не помогает.
Вы свой код на тяжелых видео пробовали? не тормозит?

Цитата:
Сообщение от Pavia
GdiFlush
слишком сложно. Я не умею с драйверами работать.
Я изначально так и предполагал, что вывод 1000/fps кадров должен тормозить априори. Но раз уж есть такая штука как Callback, думал я, всё должно работать. А оказалось, что не работает. Я думал это у меня в коде ошибка. Тогда не понимаю, для чего нужен callback, если не для вывода.
BLACK_RAIN вне форума   Ответить с цитированием
Старый 21.04.2017, 11:21   #13
Aliens_wolfs
Участник клуба
 
Регистрация: 16.12.2009
Адрес: WWW ЛЕНИНГРАД СПб точка РУ
Сообщений: 860
Репутация: 435
По умолчанию

Цитата:
ну так про NullRenderer я и говорил. Я знаю как его подключать. Только это не помогает.
Код выше то что выделено жирным в play попробуйте всю эту функцию

Цитата:
Но раз уж есть такая штука как Callback, думал я, всё должно работать. А оказалось, что не работает. Я думал это у меня в коде ошибка. Тогда не понимаю, для чего нужен callback, если не для вывода.
Да у меня работает норм 720p HD но еще тяжелее видео не
пробовал пока. Сейчас попробую

Мой Callback попробуйте и Play. Задокументируете в Callback в чем не хотите работать но у меня и в PAneli и в Bitmap нормально

Тормозить может как я уже намикал на то что у вас pVideoWindow создает окно для вывода видео хоть оно и скрыто, у вас видео в двух потоках

Последний раз редактировалось Aliens_wolfs; 21.04.2017 в 11:38.
Aliens_wolfs вне форума   Ответить с цитированием
Старый 21.04.2017, 11:38   #14
BLACK_RAIN
Участник клуба
 
Регистрация: 13.02.2012
Сообщений: 512
Репутация: 119
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
Тормозить может как я уже намикал на то что у вас pVideoWindow создает окно для вывода видео хоть оно и скрыто, у вас видео в двух потоках
Ничего у меня не скрыто. Я пробовал и с NullRenderer'ом и без него. На тяжелых идео даёт примерно 20 fps в режиме COLORONCOLOR и звук опережает картинку.
Подключать пины вручную не пробовал. Но не думаю, что это ускорит отрисовку.
На SD видео у меня тоже нет проблем с отрисовкой.
BLACK_RAIN вне форума   Ответить с цитированием
Старый 21.04.2017, 11:41   #15
Aliens_wolfs
Участник клуба
 
Регистрация: 16.12.2009
Адрес: WWW ЛЕНИНГРАД СПб точка РУ
Сообщений: 860
Репутация: 435
По умолчанию

Цитата:
Ничего у меня не скрыто.
pVideoWindow это лишнее окно вывода изображения, а вы работает и с ним и в callBаck
Процессор работает на два потока по обработке видео, с большим видео и будет тормозить

с каким разрешением видео пробуете?

Последний раз редактировалось Aliens_wolfs; 21.04.2017 в 11:47.
Aliens_wolfs вне форума   Ответить с цитированием
Старый 21.04.2017, 11:47   #16
BLACK_RAIN
Участник клуба
 
Регистрация: 13.02.2012
Сообщений: 512
Репутация: 119
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
pVideoWindow это окно вывода изображения, а вы работает и с ним и в callBаck
говорю же - я пробовал и так и так.

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
с каким разрешением видео пробуете?
в пределах 1920х1080. Не больше.
BLACK_RAIN вне форума   Ответить с цитированием
Старый 21.04.2017, 11:48   #17
Aliens_wolfs
Участник клуба
 
Регистрация: 16.12.2009
Адрес: WWW ЛЕНИНГРАД СПб точка РУ
Сообщений: 860
Репутация: 435
По умолчанию

Сейчас у себя проверю
А так я вообще от DS перешел на компонент PasLibVLC он с высоким разрешением видео работает нормально да и по сетевым ресурсам с потоками работает основан на DS

Скачал клип от сюда https://mirclipov.com/rus/75522-monatik-kruzhit.html AVC 1920X1080 25.000 fps все четко работает сразу в Panel и Image

вот весь код
Код:


type
  TForm1 = class(TForm, ISampleGrabberCB)
.....................................

  public
    FHDCBitmap: HBitmap;
    pWidthVideo, pHeightVideo: integer;
    FDC: HDC;

    pFilterSampleGrabber: IBaseFilter;
    pMediaPosition: IMediaPosition;
    pNullRenderer: IBaseFilter;
    pGraphBuilder: IGraphBuilder;
    pVideoWindow: IVideoWindow;
    pVideoGrabber: ISampleGrabber;
    pMediaControl: IMediaControl;
    function BufferCB(SampleTime: Double; pBuffer: PByte; BufferLen: Integer): HResult; stdcall;
    function SampleCB(SampleTime: Double; pSample: IMediaSample): HResult; stdcall;
   procedure ClearGraph;
   function Play(FileName: String): HRESULT;
  end;

var
  Form1: TForm1;

implementation

function GetPin(pFilter: IBaseFilter; PintDir: TPinDirection): IPin;
var
  bFound: Boolean;
  pEnum: IEnumPins;
  pPin: IPin;
  hr: HRESULT;
  PinDirThis: TPinDirection;
begin
  Result := NIL;
  bFound := False;

  hr := pFilter.EnumPins(pEnum);
  if Failed(hr) then
    Exit;

  while (pEnum.Next(1, pPin, NIL) = S_OK) do
  begin
    pPin.QueryDirection(PinDirThis);
    bFound := (PintDir = PinDirThis);
    if bFound then
      Break;
    pPin := NIL;
  end;

  pEnum := NIL;
  if bFound then
    Result := pPin;
end;

procedure RemoveDefault(pGraph: IGraphBuilder; pNULLRenderer, pGrabberBase: IBaseFilter);
var
  pVidRenderer, pColorConverter: IBaseFilter;
  Pin, oPin: IPin;
begin
  pGraph.FindFilterByName('Video Renderer', pVidRenderer);
  if (pVidRenderer <> NIL) then
  begin
    Pin := GetPin(pVidRenderer, PINDIR_INPUT);
    oPin := NIL;
    Pin.ConnectedTo(oPin);
    Pin.Disconnect;
    oPin.Disconnect;
    Pin := NIL;

    pGraph.RemoveFilter(pVidRenderer);
    pVidRenderer := NIL;

    pGraph.FindFilterByName('Color Space Converter', pColorConverter);
    if (pColorConverter <> NIL) then
    begin
      oPin := NIL;
      Pin := GetPin(pColorConverter, PINDIR_INPUT);
      Pin.ConnectedTo(oPin);
      Pin.Disconnect;
      oPin.Disconnect;
      Pin := NIL;

      pGraph.RemoveFilter(pColorConverter);
      pColorConverter := NIL;
    end;

    Pin := GetPin(pGrabberBase, PINDIR_INPUT);
    pGraph.Connect(oPin, Pin);
    Pin := NIL;
    oPin := NIL;

    oPin := GetPin(pGrabberBase, PINDIR_OUTPUT);
    Pin := GetPin(pNULLRenderer, PINDIR_INPUT);

    pGraph.Connect(oPin, Pin);
    Pin := NIL;
    oPin := NIL;
  end;
end;

function TForm1.BufferCB(SampleTime: Double; pBuffer: PByte;
  BufferLen: Integer): HResult;
begin
  Result := S_OK;
end;


function TForm1.SampleCB(SampleTime: Double; pSample: IMediaSample): HResult;
 type
  PVDByteArray = ^TVDByteArray;
  TVDByteArray = array[0..$FFFF] of byte;
var
  BitmapInfoHeader: PBitmapInfoHeader;
  BitmapInfo : TBitmapInfo;
  MediaType: TAMMediaType;
  DIBSize: Integer;
  pBuffer: PVDByteArray;
  pPixel: PVDByteArray;
  memDC: HDC;
begin

  if (pSample.GetSize = 0) then
    Exit;

    Result := pVideoGrabber.GetConnectedMediaType(MediaType);
  if Failed(Result) then
    Exit;

  if IsEqualGUID(MediaType.majortype, MEDIATYPE_Video) then
  begin
    BitmapInfoHeader := NIL;
    if IsEqualGUID(MediaType.formattype, FORMAT_VideoInfo) then
    begin
      if (MediaType.cbFormat >= SizeOf(TVideoInfoHeader)) then
        BitmapInfoHeader := @(PVideoInfoHeader(MediaType.pbFormat)^.bmiHeader);
    end;
    if (BitmapInfoHeader = NIL) then
      Exit;

    DIBSize := BitmapInfoHeader^.biSizeImage;
    if (DIBSize = 0) then
    begin
      with BitmapInfoHeader^ do
        DIBSize := 3 * biWidth * biHeight * biPlanes;
      BitmapInfoHeader^.biSizeImage := DIBSize;
    end;

    pSample.GetPointer(PByte(pBuffer));

   BitmapInfo.bmiHeader:= BitmapInfoHeader^;


   //рисуем на Panel1
//=========================================================
  FDC:= GetDC(Panel1.Handle);
  pWidthVideo:= Panel1.Width;
  pHeightVideo:= Panel1.Height;

//если сделать так то кортика будет тех размеров что и оригинал
//pWidthVideo:= 0;
//pHeightVideo:= 0;
  
    // Выводит видео на DC
 if FDC > 0 then
 begin
 if (pWidthVideo = 0)and(pHeightVideo = 0) then
  StretchDIBits(FDC, 0, 0, BitmapInfoHeader.biWidth, BitmapInfoHeader.biHeight,
  0, 0, BitmapInfoHeader^.biWidth, BitmapInfoHeader^.biHeight, pBuffer, BitmapInfo, DIB_RGB_COLORS, SRCCOPY)
 else
 StretchDIBits(FDC, 0, 0, pWidthVideo, pHeightVideo, 0, 0, BitmapInfoHeader^.biWidth,
 BitmapInfoHeader^.biHeight, pBuffer, BitmapInfo, DIB_RGB_COLORS, SRCCOPY);
 end;

  //либо Выводим видео в HBitmap если не нужно то этот блок можно за комментировать
//=========================================================
 pWidthVideo:= Image1.Width;
 pHeightVideo:= Image1.Height;

//если сделать так то кортика будет тех размеров что и оригинал
//pWidthVideo:= 0;
//pHeightVideo:= 0;

 MemDC:= CreateCompatibleDC(FDC);
 FHDCBitmap:= CreateDIBSection(MemDC, BitmapInfo, DIB_RGB_COLORS, Pointer(pPixel), 0, 0);
 SelectObject(MemDC, FHDCBitmap);
 if (pWidthVideo = 0)and(pHeightVideo = 0) then
 StretchDIBits(MemDC, 0, 0, BitmapInfoHeader.biWidth, BitmapInfoHeader.biHeight,
 0, 0, BitmapInfoHeader^.biWidth, BitmapInfoHeader^.biHeight, pBuffer, BitmapInfo, DIB_RGB_COLORS, SRCCOPY)
 else
 StretchDIBits(MemDC, 0, 0, pWidthVideo, pHeightVideo, 0, 0, BitmapInfoHeader^.biWidth,
 BitmapInfoHeader^.biHeight, pBuffer, BitmapInfo, DIB_RGB_COLORS, SRCCOPY);
 DeleteDC(MemDC);

 Image1.Picture.Bitmap.Handle:= FHDCBitmap;

DeleteDC(FHDCBitmap);
//=========================================================
   Result := S_OK;
  end;
end;


procedure TForm1.ClearGraph;
begin
  if Assigned(pMediaControl) then
  pMediaControl.Stop;
  pVideoGrabber := nil;
  pMediaControl := nil;
  pGraphBuilder := nil;
end;


function TForm1.Play(FileName: String): HRESULT;
var
  MediaType: TAMMediaType;
begin
  ClearGraph;
try
  Result:= CoCreateInstance(CLSID_FilterGraph, NIL, CLSCTX_INPROC_SERVER, IID_IGraphBuilder, pGraphBuilder);
   if Result <> S_OK then
  exit;

  Result:= pGraphBuilder.RenderFile(PWCHAR(WideString(FileName)), NIL);
   if Result <> S_OK then
  exit;

  Result:= CoCreateInstance(CLSID_SampleGrabber, NIL, CLSCTX_INPROC_SERVER, IID_IBaseFilter, pFilterSampleGrabber);
  pFilterSampleGrabber.QueryInterface(IID_ISampleGrabber, pVideoGrabber);
   if Result <> S_OK then
  exit;

  FillChar(MediaType, SizeOf(MediaType), 0);
  MediaType.majortype := MEDIATYPE_Video;
  MediaType.subtype := MEDIASUBTYPE_RGB24;
  pVideoGrabber.SetMediaType(MediaType);
  pVideoGrabber.SetBufferSamples(True);
  pVideoGrabber.SetOneShot(False);
  pVideoGrabber.SetCallback(Self, 0);
  pGraphBuilder.AddFilter(pFilterSampleGrabber, 'Sample Grabber');

  Result:= CoCreateInstance(CLSID_NullRenderer, NIL, CLSCTX_INPROC_SERVER, IID_IBaseFilter, pNullRenderer);
  pGraphBuilder.AddFilter(pNullRenderer, 'Null Renderer');
  if Result <> S_OK then
  exit;
  RemoveDefault(pGraphBuilder, pNullRenderer, pFilterSampleGrabber);

  pGraphBuilder.QueryInterface(IID_IMediaControl, pMediaControl);
  pGraphBuilder.QueryInterface(IID_IMediaPosition, pMediaPosition);

  pMediaPosition.put_CurrentPosition(0);
  pMediaControl.Run;

 finally
 if Result <> S_OK then
  ClearGraph;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Play('222.mp4');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ClearGraph;
end;


Последний раз редактировалось Aliens_wolfs; 21.04.2017 в 13:44.
Aliens_wolfs вне форума   Ответить с цитированием
Старый 21.04.2017, 13:00   #18
BLACK_RAIN
Участник клуба
 
Регистрация: 13.02.2012
Сообщений: 512
Репутация: 119
По умолчанию

вы ведь с формой пишете? у вас память не жрёт?
BLACK_RAIN вне форума   Ответить с цитированием
Старый 21.04.2017, 13:16   #19
Aliens_wolfs
Участник клуба
 
Регистрация: 16.12.2009
Адрес: WWW ЛЕНИНГРАД СПб точка РУ
Сообщений: 860
Репутация: 435
По умолчанию

Не много, не критично, знаю что не совсем правильно, а так делал модуль USampleGrabber для кое какого проекта, из него и вытащил callback чтобы тут простенький код показать

Сравнил память с Windows Media с одним и тем же видео так примерно так же кушает и то потому что у меня в двух окнах, если одно откл то меньше.

Последний раз редактировалось Aliens_wolfs; 21.04.2017 в 13:28.
Aliens_wolfs вне форума   Ответить с цитированием
Старый 21.04.2017, 13:24   #20
BLACK_RAIN
Участник клуба
 
Регистрация: 13.02.2012
Сообщений: 512
Репутация: 119
По умолчанию

Ладно. Попробую ваш код и потом отпишусь.
Мне сейчас показалось, что проблема может быть в том, что у меня просто комп модели "кастрюля с лампочками"

Последний раз редактировалось BLACK_RAIN; 21.04.2017 в 13:27.
BLACK_RAIN вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Wi Fi глючит nikox12 Железо 5 03.05.2014 20:26
Глючит изображение Problem Общие вопросы Delphi 9 22.08.2011 07:31
глючит комп voldemen Железо 1 15.05.2010 13:37
глючит Oracle Dawystrik SQL, базы данных 11 13.09.2009 19:19
Глючит Excel ---FISHER--- Общие вопросы Delphi 34 09.08.2009 20:30


03:07.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru