用Delphi+DirectShow实现的视频播放器，可用于游戏片头播放

unit Mpeg;

interface

uses
  Windows, Classes, Messages, ActiveX, Controls, DShow;
  
type
  TMpegPlayer = class
  private
    FWindow: THandle;
    FErrorMsg: string;

    FGraphBuilder: IGraphBuilder;
    FMediaControl: IMediaControl; // 播放状态设置.
    FMediaSeeking: IMediaSeeking; // 播放位置.
    FAudioControl: IBasicAudio; // 音量/平衡设置.
    FVideoWindow: IVideoWindow; //设置播放表单.
    FMediaEvent: IMediaEventEx; //事件

    FInited: Boolean;
    FPlaying: Boolean;
    FVideoFile: string;
    FMovieWindow: TWinControl;

    FOnComplate: TNotifyEvent;
    procedure DoInit;
    procedure Close;
    { Private declarations }
    procedure WndProc(var Msg: TMessage);
  public
    constructor Create(PlayWindow: TWinControl);
    destructor Destroy; override;

    function Play(VideoFile: string): Boolean;
    procedure Pause();
    procedure Stop();
    { Public declarations }
    property OnComplate: TNotifyEvent read FOnComplate write FOnComplate;
    property ErrorMsg: string read FErrorMsg;
  end;

implementation

const
  WM_MMNOTIFY = $0400 + 1;

var
  MpegMsgWindowClass: TWndClass = (
    style: 0;
    lpfnWndProc: @DefWindowProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: 0;
    lpszMenuName: nil;
    lpszClassName: 'MpegMsgWindowClass');

function AllocateHWnd(const aWindowName: string; Method: TWndMethod): HWND;
var tmpclass: TWndClass;
    isClsRegistered: Boolean;
begin
  MpegMsgWindowClass.hInstance := HInstance;
  isClsRegistered := GetClassInfo(HInstance, MpegMsgWindowClass.lpszClassName, tmpclass);

  if not isClsRegistered or (tmpclass.lpfnWndProc <> @DefWindowProc) then begin
    if isClsRegistered then Windows.UnregisterClass(MpegMsgWindowClass.lpszClassName, HInstance);
    Windows.RegisterClass(MpegMsgWindowClass);
  end;

  Result := CreateWindowEx(WS_EX_TOOLWINDOW, MpegMsgWindowClass.lpszClassName,
    PChar(aWindowName), WS_POPUP {!0}, 0, 0, 0, 0, 0, 0, HInstance, nil);

  if Assigned(Method) then
    SetWindowLong(Result, GWL_WNDPROC, Longint({$IFDEF DELPHI6UP}Classes.{$ENDIF}MakeObjectInstance(Method)));
end;

{ TMpegPlayer }

procedure TMpegPlayer.Close;
begin
  if Assigned(FMediaEvent) then
  begin
    FMediaEvent.SetNotifyWindow(0, 0, 0);
    FMediaEvent := nil;
  end;
  if Assigned(FMediaControl) then FMediaControl.Stop; // 释放所有用到的介面。

  if Assigned(FAudioControl) then FAudioControl := nil;
  if Assigned(FMediaSeeking) then FMediaSeeking := nil;
  if Assigned(FMediaControl) then FMediaControl := nil;
  if Assigned(FVideoWindow) then FVideoWindow := nil;
  if Assigned(FGraphBuilder) then FGraphBuilder := nil;

  CoUninitialize;
  FInited := False;
end;

constructor TMpegPlayer.Create(PlayWindow: TWinControl);
begin
  FMovieWindow := PlayWindow;
  FWindow := AllocateHWnd('MepgPlayer', WndProc);//给当前类制造一个可以接收消息的窗口句柄
  FGraphBuilder := nil;
  FMediaControl := nil;
  FMediaSeeking := nil;
  FAudioControl := nil;
  FVideoWindow := nil;
  //FInited := Init();
  FInited := False;
end;

destructor TMpegPlayer.Destroy;
begin
  Close();
  inherited;
end;

procedure TMpegPlayer.DoInit;
begin
  FInited := False; // 初始化COM介面
  if Failed(CoInitialize(nil)) then Exit; // 创建DirectShow Graph

  //初始化DirectShow
  if Failed(CoCreateInstance(TGUID(CLSID_FilterGraph), nil, CLSCTX_INPROC, TGUID(IID_IGraphBuilder), FGraphBuilder)) then Exit; // 获取IMediaControl 介面
  if Failed(FGraphBuilder.QueryInterface(IID_IBasicAudio, FAudioControl)) then Exit;    //用于控制音量
  if Failed(FGraphBuilder.QueryInterface(IID_IMediaSeeking, FMediaSeeking)) then Exit;  //用于控制播放进度
  if Failed(FGraphBuilder.QueryInterface(IID_IMediaControl, FMediaControl)) then Exit; // 获取IMediaSeeking 介面
  if Failed(FGraphBuilder.QueryInterface(IID_IVideoWindow, FVideoWindow)) then Exit; // 所有介面获取成功 R
  if Failed(FGraphBuilder.QueryInterface(IID_IMediaEventEx, FMediaEvent)) then Exit; //事件

  if Assigned(FOnComplate) then
    FMediaEvent.SetNotifyWindow(FWindow, WM_MMNOTIFY, 0);

  FInited := True;
end;

procedure TMpegPlayer.Pause;
begin
  FMediaControl.Pause;
end;

function TMpegPlayer.Play(VideoFile: string): Boolean;
var
  hr: HResult;
begin
  Result := False;
  FVideoFile := VideoFile;
  if not FInited then
    DoInit;
  hr := FGraphBuilder.RenderFile(PWideChar(WideString(FVideoFile)), nil);
  if Failed(hr) then Exit;

  if FMovieWindow <> nil then
  begin
    FVideoWindow.put_Owner(FMovieWindow.Handle);
    FVideoWindow.put_windowstyle(WS_CHILD or WS_Clipsiblings);
    FVideoWindow.SetWindowposition(0, 0, FMovieWindow.ClientWidth, FMovieWindow.ClientHeight); //播放的图像为整个panel1的ClientRect//
  end;

  //  FAudioControl.put_Volume(VOLUME_FULL);//设置为最大音量

  FMediaControl.Run;
  Result := True;
  FPlaying := True;
end;

procedure TMpegPlayer.Stop;
begin
  if not FInited then Exit;
  FMediaControl.Stop;
  Close;
end;

procedure TMpegPlayer.WndProc(var Msg: TMessage);
var
  pcds: PCopyDataStruct;
  ecode, p1, p2: Integer;
begin
  case Msg.Msg of
    WM_MMNOTIFY:
    begin
      while Succeeded(FMediaEvent.GetEvent(ecode, p1, p2, 0)) do
      begin
        FMediaEvent.FreeEventParams(ecode, p1, p2);
        case ecode of
          EC_COMPLETE: FOnComplate(Self);
          EC_USERABORT: ;
          EC_ERRORABORT: ;
        end;
      end;
    end
  else
    Msg.Result := DefWindowProc(FWindow, Msg.Msg, Msg.wParam, Msg.lParam);
  end;
end;

end.

完整Demo下载地址