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下载地址