Последние записи
- Рандомное слайдшоу
- Событие для произвольной области внутри TImage
- Удаление папки с файлами
- Распечатка файла
- Преобразовать массив байт в вещественное число (single)
- TChromium (CEF3), сохранение изображений
- Как в Delphi XE обнулить таймер?
- Изменить цвет шрифта TextBox на форме
- Ресайз PNG без потери прозрачности
- Вывод на печать графического файла
Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk
Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw
5th
Июл
ВидеоПлеер в Delphi
Posted by bullvinkle under Исходники
Переопределяем SampleGrabber и получаем каждый кадр в свой буфер, его выводим куда и чем угодно Вам.
type
TArRGBTriple = array[0..0] of TRGBTriple;
PArRGBTriple = ^TArRGBTriple;
function GetPin(pFilter: IBaseFilter; PintDir: TPinDirection): IPin;
procedure RemoveDefault(pGraph: IGraphBuilder; pNULLRenderer, pGrabberBase: IBaseFilter);
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;
пример набросок
...
TfrmExample = class(TForm, ISampleGrabberCB)
private
function SampleCB(SampleTime: Double; pSample: IMediaSample): HResult; stdcall;
function BufferCB(SampleTime: Double; pBuffer: PByte; BufferLen: longint): HResult; stdcall;
...
GraphBuilder: IGraphBuilder;
FilterSampleGrabber: IBaseFilter;
SampleGrabber: ISampleGrabber;
MediaControl: IMediaControl;
MediaPosition: IMediaPosition;
NullRenderer: IBaseFilter;
end;
...
function TfrmExample.BufferCB(SampleTime: Double; pBuffer: PByte;
BufferLen: Integer): HResult;
begin
Result := S_OK;
end;
function TfrmExample.SampleCB(SampleTime: Double; pSample: IMediaSample): HResult;
var
BmpHead: PBitmapInfoHeader;
MediaType: TAMMediaType;
DIBSize: Integer;
pBuffer: PByte;
begin
Result := S_OK;
if (pSample.GetSize = 0) then
Exit;
Result := SampleGrabber.GetConnectedMediaType(MediaType);
if Failed(Result) then
Exit;
if IsEqualGUID(MediaType.majortype, MEDIATYPE_Video) then
begin
BmpHead := NIL;
if IsEqualGUID(MediaType.formattype, FORMAT_VideoInfo) then
begin
if (MediaType.cbFormat = SizeOf(TVideoInfoHeader)) then
BmpHead := @(PVideoInfoHeader(MediaType.pbFormat)^.bmiHeader);
end;
if (BmpHead = NIL) then
Exit;
DIBSize := BmpHead^.biSizeImage;
if (DIBSize = 0) then
begin
with BmpHead^ do
DIBSize := 3 * biWidth * biHeight * biPlanes;
BmpHead^.biSizeImage := DIBSize;
end;
pSample.GetPointer(pBuffer);
// вот необходимые данные для работы с растром текущего кадра
// BmpHead^.biWidth, BmpHead^.biHeight, BmpHead^.biWidth * 3, PixelFormat24bppRGB, pBuffer
end;
end;
как запускать Play/Pause/Stop
procedure TfrmExample.Play;
var
MediaType: TAMMediaType;
Result: HRESULT;
begin
GraphBuilder := NIL;
FilterSampleGrabber := NIL;
SampleGrabber := NIL;
MediaControl := NIL;
MediaPosition := NIL;
NullRenderer := NIL;
CoCreateInstance(CLSID_FilterGraph, NIL, CLSCTX_INPROC_SERVER, IID_IGraphBuilder, GraphBuilder);
Result := GraphBuilder.RenderFile(PWCHAR(WideString('My Video File')), NIL);
if Failed(Result) then
Exit;
CoCreateInstance(CLSID_SampleGrabber, NIL, CLSCTX_INPROC_SERVER, IID_IBaseFilter, FilterSampleGrabber);
FilterSampleGrabber.QueryInterface(IID_ISampleGrabber, SampleGrabber);
FillChar(MediaType, SizeOf(MediaType), 0);
MediaType.majortype := MEDIATYPE_Video;
MediaType.subtype := MEDIASUBTYPE_RGB24;
SampleGrabber.SetMediaType(MediaType);
SampleGrabber.SetBufferSamples(True);
SampleGrabber.SetOneShot(False);
SampleGrabber.SetCallback(Self, 0);
GraphBuilder.AddFilter(FilterSampleGrabber, 'Sample Grabber');
CoCreateInstance(CLSID_NullRenderer, NIL, CLSCTX_INPROC_SERVER, IID_IBaseFilter, NullRenderer);
GraphBuilder.AddFilter(NullRenderer, 'Null Renderer');
RemoveDefault(GraphBuilder, NullRenderer, FilterSampleGrabber);
GraphBuilder.QueryInterface(IID_IMediaControl, MediaControl);
GraphBuilder.QueryInterface(IID_IMediaPosition, MediaPosition);
MediaPosition.get_Duration(VideoLen);
MediaControl.Run;
end;
procedure TfrmExample.Pause;
begin
MediaControl.Pause;
end;
procedure TfrmExample.Stop;
begin
MediaControl.StopWhenReady;
FilterSampleGrabber := NIL;
SampleGrabber := NIL;
MediaControl := NIL;
MediaPosition := NIL;
NullRenderer := NIL;
GraphBuilder := NIL;
end;
Похожие статьи
Купить рекламу на сайте за 1000 руб
пишите сюда - alarforum@yandex.ru
Да и по любым другим вопросам пишите на почту
пеллетные котлы
Пеллетный котел Emtas
Наши форумы по программированию:
- Форум Web программирование (веб)
- Delphi форумы
- Форумы C (Си)
- Форум .NET Frameworks (точка нет фреймворки)
- Форум Java (джава)
- Форум низкоуровневое программирование
- Форум VBA (вба)
- Форум OpenGL
- Форум DirectX
- Форум CAD проектирование
- Форум по операционным системам
- Форум Software (Софт)
- Форум Hardware (Компьютерное железо)