Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

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

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

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.04.2017, 14:37   #1
BLACK_RAIN
Форумчанин
 
Регистрация: 13.02.2012
Сообщений: 867
По умолчанию SampleGrabberCallback глючит

Здравствуйте.
Использую sampleGrabberCallback для вывода изображения на форму.

Код:
function TForm1.SampleCB(SampleTime: Double; pSample: IMediaSample): HRESULT;
begin
  Result := 0;
end;

function TForm1.BufferCB(SampleTime: Double; pBuffer: PByte; BufferLen: Integer): HRESULT;
var
  mt : TAMMediaType;
  bmpInfo : TBitmapInfo;
  vih : TVideoInfoHeader;
  HBMP : HBITMAP;
  tmp : array of Byte;
  buffer : Pointer;
  dc : HDC;
begin
  pVideoGrabber.GetConnectedMediaType(mt);
  vih := tvideoinfoheader(mt.pbFormat^);
  ZeroMemory(@bmpinfo,SizeOf(tbitmapinfo));
  CopyMemory(@bmpinfo.bmiheader,@vih.bmiheader,SizeOf(tbitmapinfoheader));
  Buffer := nil;
  hbmp := CreateDIBSection(0,BMPInfo,DIB_PAL_COLORS, BUFFER,0,0);
  if (HBMP = 0) or (HBMP = ERROR_INVALID_PARAMETER) then
  begin
	MoFreeMediaType(@mt);
    ShowMessage('error');
    Exit;
  end;
  bmp := TBitmap.Create;
  bmp.Handle := HBMP;
  Caption := IntToStr(bmp.Height);
  SetLength(tmp,BufferLen);
  CopyMemory(buffer,pBuffer,mt.lSampleSize);
  MoFreeMediaType(@mt);
  Canvas.StretchDraw(ClientRect,bmp);
//  DeleteObject(HBMP);
  bmp.Free;
  Result := 0;
end;

procedure TForm1.ClearGraph;
begin
  if Assigned(pMediaControl) then
  pMediaControl.Stop;

  fVideoRenderer := nil;
  fVideoDecoder := nil;
  pVideoWindow := nil;
//  pVideoGrabber.SetCallback(nil,0);
  pVideoGrabber := nil;
  fVideoGrabber := nil;
  pSource := nil;
  fSource := nil;
  pMediaControl := nil;
  pMediaPosition := nil;
  pGraphBuilder := nil;
  pCaptureGraphBuilder := nil;
end;

function TForm1.BuildGraph(fn: string): HRESULT;
var
  mtv : AM_MEDIA_TYPE;
begin

  Result := CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC_SERVER ,
                           IID_IGraphBuilder, pGraphBuilder);
  Result := CoCreateInstance(CLSID_CaptureGraphBuilder2, NIL,
                          CLSCTX_INPROC_SERVER, IID_ICaptureGraphBuilder2,
                         pCaptureGraphBuilder);
  pCaptureGraphBuilder.SetFiltergraph(pGraphBuilder);

  Result := pGraphBuilder.AddSourceFilter(StringToOleStr(fn),'source', fSource);



  Result := coCreateInstance(CLSID_FfdshowVideoDecoder, nil,
                               CLSCTX_INPROC_SERVER,
                               IID_IBaseFilter, FVIDEODECODER);
  pGraphBuilder.AddFilter(fVideoDecoder, 'ffdshow video');

  Result := coCreateInstance(CLSID_VideoRendererDefault, nil,
                               CLSCTX_INPROC_SERVER,
                               IID_IBaseFilter, fVideoRenderer);
  pGraphBuilder.AddFilter(fVideoRenderer, 'video renderer');

  Result := coCreateInstance(CLSID_SampleGrabber, nil,
                               CLSCTX_INPROC_SERVER,
                               IID_ISampleGrabber, pVideoGrabber);
  ZeroMemory(@mtv, SizeOf(mtv));
  mtv.majortype := MEDIATYPE_Video;
  mtv.subtype := MEDIASUBTYPE_RGB24;
  mtv.formattype := FORMAT_VideoInfo;

  pVideoGrabber.SetMediaType(mtv);
  pVideoGrabber.SetOneShot(False);
  pVideoGrabber.SetBufferSamples(True);
  pVideoGrabber.setCallback(Self,1);
  pVideoGrabber.QueryInterface(IID_IBaseFilter, fvideograbber);
  pGraphBuilder.AddFilter(fVideoGrabber, 'video grabber');

  Result := pCaptureGraphBuilder.RenderStream(nil,@mediatype_video,
                             fSource, fVideoDecoder,fVideoGrabber);
  Result := pCaptureGraphBuilder.RenderStream(nil,@mediatype_video,
                             fVideoGrabber, nil, fVideoRenderer);

  if Result = 0 then
  begin
    pGraphBuilder.QueryInterface(IID_IVideoWindow, pvideowindow);
    pVideoWindow.put_Owner(pnl1.Handle);
    pVideoWindow.put_WindowStyle(WS_CHILD or WS_CLIPSIBLINGS);
    pVideoWindow.SetWindowPosition(0,0, pnl1.Width,pnl1.Height);
    pGraphBuilder.QueryInterface(IID_IMediaPosition,pmediaposition);
    pMediaPosition.put_CurrentPosition(35);
    pGraphBuilder.QueryInterface(IID_IMediaControl,pMediaControl);
    pMediaControl.Run;
  end else

  ClearGraph;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ClearGraph;
  CoUninitialize;
end;
проблемы:
1) через какое-то время изображение на форме перестаёт обновляться. В окне IVideoWindow видео продолжает нормально идти. Если потаскать
окно, то канва снова начинает обновляться. Иногда выдаёт ошибку canvas does not allow drawing.
2) Иногда при закытии окна, процесс остаётся висеть.

Последний раз редактировалось BLACK_RAIN; 19.04.2017 в 14:41.
BLACK_RAIN вне форума Ответить с цитированием
Старый 19.04.2017, 21:59   #2
Pavia
Лис
Старожил
 
Аватар для Pavia
 
Регистрация: 18.09.2015
Сообщений: 2,409
По умолчанию

Мои мысли на этот счёт. Может кто-то более умный что-то другое подскажет или посоветует.
1)
Цитата:
Иногда выдаёт ошибку canvas does not allow drawing.
Суть в том что виндоус «тормоз». Он возвращает управление в ваш код прежде чем реально выведет рисунок. Это никак не побороть, я прошёл по всему пути в плоть до драйверов. Только делать паузу, объект разрушать после вывода спустя х миллисекунд может быть доли микросекунд надо пробовать проверять.

2)
Цитата:
через какое-то время изображение на форме перестаёт обновляться.
Ваш грабер не успевает за работой конвейра. Те вы выводите дольше, чем частота захвата. Как бороться надо думать.
StretchDraw - очень медленная операция.
У меня на весь экран в режиме энерго сбережения она тратит 150 мс. Это 6٫6 кадров/секунду.

Варианты решения:
- Уменьшить скорость захвата/воспроизведения.
- Делать пропуски, не каждый кадр выводить.
- Совсем отказаться от StretchDraw.
- Задействовать GPU для вывода. Достаточно использовать рендер по умолчанию он уже оптимизирован под это дело.
- Использовать более быструю библиотеку для масштабирования. Сильно много не выиграешь, но уложиться в приемлемый результат возможно.

Я бы сделал так в BufferCB мы все данные кладём в накопитель(буфер). Это позволит контейнеру не простаивать. А в параллельном потоке, уже извлекаем данные и решаем выводить или пропускать кадр.
Хорошо поставленный вопрос это уже половина ответа. | Каков вопрос, таков ответ.
У дзен программиста программа делает то что он хотел, а не то что он написал .
Pavia вне форума Ответить с цитированием
Старый 20.04.2017, 10:05   #3
BLACK_RAIN
Форумчанин
 
Регистрация: 13.02.2012
Сообщений: 867
По умолчанию

Цитата:
Сообщение от Pavia Посмотреть сообщение
- Совсем отказаться от StretchDraw.
ну я вообще-то на WinAPI пишу. А форму использую только для предварительных тестов.
Сейчас написал вот так:
Код:
  dc := GetDC(Panel1.Handle);
  StretchBlt(dc,0,0,Panel1.Width,Panel1.Height,bmp.Canvas.Handle,0,0,bmp.Width,bmp.Height,SRCCOPY);
  ReleaseDC(Panel1.Handle,dc);
  dc := GetDC(Panel2.Handle);
  StretchBlt(dc,0,0,Panel2.Width,Panel2.Height,bmp.Canvas.Handle,0,0,bmp.Width,bmp.Height,SRCCOPY);
  ReleaseDC(Panel2.Handle,dc);
  dc := GetDC(handle);
  StretchBlt(dc,0,0,Width,Height,bmp.Canvas.Handle,0,0,bmp.Width,bmp.Height,SRCCOPY);
  ReleaseDC(Handle,dc);
то есть, вывожу сразу в три окна + IVideoWindow. Естественно, вывод подтормаживает и кадры часто выпадают. Но для меня это не критично. Главное, что вывод совсем не зависает.
Но тогда программа начинает жрать память. И через какое-то время выдаётся ошибка Out of memory.


Цитата:
Сообщение от Pavia Посмотреть сообщение
Суть в том что виндоус «тормоз». Он возвращает управление в ваш код прежде чем реально выведет рисунок.
Если всё так плохо, зачем тогда вообще был создан Callback? Ведь система, как вы говорите, не успевает выполнять код.
BLACK_RAIN вне форума Ответить с цитированием
Старый 20.04.2017, 13:50   #4
BLACK_RAIN
Форумчанин
 
Регистрация: 13.02.2012
Сообщений: 867
По умолчанию

заметил, что когда водишь мышью по форме, картинка начинает заметно тормозить, а процесс жрет памяти еще больше.
Что это значит?
BLACK_RAIN вне форума Ответить с цитированием
Старый 20.04.2017, 17:58   #5
Pavia
Лис
Старожил
 
Аватар для Pavia
 
Регистрация: 18.09.2015
Сообщений: 2,409
По умолчанию

Виндоус это
Хорошо поставленный вопрос это уже половина ответа. | Каков вопрос, таков ответ.
У дзен программиста программа делает то что он хотел, а не то что он написал .
Pavia вне форума Ответить с цитированием
Старый 20.04.2017, 18:21   #6
Pavia
Лис
Старожил
 
Аватар для Pavia
 
Регистрация: 18.09.2015
Сообщений: 2,409
По умолчанию

Вот такой он кривой дирек-х.
Виндоус это не система реального времени. ОС в любое время может остановить ваш код. И начать исполнять другую задачу, другой процесс или поток. Паузы такие могут быть редкими, но длинными до 250 мс.
Что-бы обработать все кадоы и не потерять их. Конвейр накапливает кадры. А потом их отдаёт в ускоренном режиме.
Это позволяет не терять кадры, но исполнение идёт неровномерно.

Но что будет если ваш код будет исполняться дольше чем 1/fps видео? В таком случае у вас в конвейре будут накапливаться кадры. Быстрее чем обрабатываться. Рано или позно произойдёт переполнение очередии.

Что-бы этого не происходило конвейр начинает выкидывать кадры.
Но в данном случае у вас задержки через чур большие больше и алгоритм майкрософта даёт сбой. Вам надо самим прореживать кадры.

Что-бы другая часть конвейра смогла работать ваш фильтр навремя исключается из работы. Ну как на время? Таймер завязан на событи и сообщения. Чем чаще вы возите мышкой тем чаще срабатывает таймер.

Таймеры в ОС не выполняются паралельно. Они все асинхронные.
Как и callback тоже асинхронные. Асинхронный код проще программировать чем паролельный.
Но в случае с DirectX я бы сказал это архитектурный прассчёт. Из-за чего все эти заплатки и родялись.

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

В принципе оно решено. Когда вы вывод делаете не сами, а через рендер по умолчанию. Но только следует соблюдать правила для колбека озвученные выше.
Хорошо поставленный вопрос это уже половина ответа. | Каков вопрос, таков ответ.
У дзен программиста программа делает то что он хотел, а не то что он написал .
Pavia вне форума Ответить с цитированием
Старый 20.04.2017, 19:10   #7
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Как то тоже делал вывод изображения callback вот мой код работает вроде норм

Код:
var 
 FHDCBitmap: HBitmap;



//рисуем в Image1 грубо говоря fps
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Image1.Picture.Bitmap.Handle:= FHDCBitmap;
 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;
  pWidthVideo, pHeightVideo: integer;
  FDC: 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;

    // Выводит видео на 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;

 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;
Это pVideoWindow.put_Owner(pnl1.Handle) в вашем коде не нужно если вы примените этот код

чтобы работал этот CallBack нужно сделать так при инициализации pVideoGrabber.setCallback(Self, 0);

Может чем нибудь и поможет этот код

интересная дискуссия здесь http://programmersforum.ru/showthread.php?t=106352 начало от поста#6

Последний раз редактировалось Aliens_wolfs; 21.04.2017 в 10:19.
Aliens_wolfs вне форума Ответить с цитированием
Старый 21.04.2017, 08:31   #8
BLACK_RAIN
Форумчанин
 
Регистрация: 13.02.2012
Сообщений: 867
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
Это pVideoWindow.put_Owner(pnl1.Handle) в вашем коде не нужно если вы примените этот код
как это не нужно? Ведь тогда откроется дополнительное окно со стандартным выводом. Если не использовать NullRenderer.
Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
интересная дискуссия здесь http://programmersforum.ru/showthread.php?t=106352 начало от поста#6
Я извиняюсь, но что именно там интересного? Там ВОВАН скопипастил код из интернета, в котором показан ОБЩИЙ ПРИНЦИП использования SampleGrabber'а. Этот код даже до конца не дописан. А автор темы не понимает, как этот код юзать.
И как это мне поможет?
BLACK_RAIN вне форума Ответить с цитированием
Старый 21.04.2017, 09:13   #9
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Цитата:
как это не нужно? Ведь тогда откроется дополнительное окно со стандартным выводом. Если не использовать NullRenderer.

Можно и без pVideoWindow.put_Owner(pnl1.Handle) ; но если удобно можете оставить как есть, все равно работает два ресурса, это окно просто скрыто
Что бы не использовать лишнее нужно правильно описать NullRenderer и в том примере на что я ссылку дал он есть в функции play

Цитата:
Я извиняюсь, но что именно там интересного? Там ВОВАН скопипастил код из интернета, в котором показан ОБЩИЙ ПРИНЦИП использования SampleGrabber'а. Этот код даже до конца не дописан. А автор темы не понимает, как этот код юзать.
И как это мне поможет?
Там код Play интересный который избавляет от лишнего pVideoWindow

Последний раз редактировалось Aliens_wolfs; 21.04.2017 в 10:18.
Aliens_wolfs вне форума Ответить с цитированием
Старый 21.04.2017, 09:32   #10
Pavia
Лис
Старожил
 
Аватар для Pavia
 
Регистрация: 18.09.2015
Сообщений: 2,409
По умолчанию

Цитата:
Иногда выдаёт ошибку canvas does not allow drawing.
Тут подсказывают что надо использовать GdiFlush()
https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx
https://msdn.microsoft.com/en-us/win...nous-rendering
https://blogs.msdn.microsoft.com/old...23-00/?p=12773
Хорошо поставленный вопрос это уже половина ответа. | Каков вопрос, таков ответ.
У дзен программиста программа делает то что он хотел, а не то что он написал .
Pavia вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
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