unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, DirectShow9, ExtCtrls;
type
 TForm1 = 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;
 
 public
   { Public declarations }
   procedure OpenFile(Path: string);
 end;
var
 Form1: TForm1;
implementation
uses
 ActiveX;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
 OpenFile('C:\ejik.wmv');
 Timer1.Enabled := True;
end;
procedure TForm1.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
                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

 Check(CoCreateInstance(CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC_SERVER,
 IID_ICaptureGraphBuilder2, FGraphBuilder));

 Check(CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC_SERVER,
   IID_IFilterGraph, FFilterGraph));

 WideStr := Path;
  Check(FFilterGraph.RenderFile(PWideChar(WideStr), nil));
  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');
 FindPin(VideoRenderer, PINDIR_INPUT, 0, inputPin);
 Check(inputPin.ConnectedTo(OutputPin));
 FFilterGraph.RemoveFilter(VideoRenderer);
 Check(CoCreateInstance(CLSID_SampleGrabber, nil, CLSCTX_INPROC_SERVER,
   IID_IBaseFilter, GrabberFilter));
 Check(grabberFilter.QueryInterface(IID_ISampleGrabber, FSampleGrabber));
 Check(FFilterGraph.AddFilter(grabberFilter, 'Sample Grabber'));
 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));

 FindPin(grabberFilter, PINDIR_INPUT, 0, inputPin);
 Check(FFilterGraph.Connect(OutputPin, inputPin));

 Check(CoCreateInstance(CLSID_NullRenderer, nil, CLSCTX_INPROC_SERVER,
   IID_IBaseFilter, nullRenderer));
 Check(FFilterGraph.AddFilter(nullRenderer, 'New Null Renderer'));
 ConnectPins(grabberFilter, 0, nullRenderer, 0);
 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));

 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 TForm1.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.