unit SRVMediaPlayer;

interface
{$I RV_Defs.inc}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  SRVControl, DShow, ActiveX;

type
  TRVMPModes = (rvmpNotReady, rvmpStopped, rvmpPlaying, rvmpPaused, rvmpOpen);

  TSRVMediaPlayer = class(TSRVRenderControl)
  private
    { Private declarations }
    MyGraphBuilder : IGraphBuilder;
    MyMediaControl : IMediaControl;
    VideoWindow : IVideoWindow;
    BasicVideo : IBasicVideo;
    MediaEvent  : IMediaEvent;
    MediaEventEx  : IMediaEventEx;
    FState : TRVMPModes;
    FFileName : String;
  protected
    { Protected declarations }
    procedure Loaded; override;
    function GetRenderVisible: Boolean; override;
    procedure SetRenderVisible(Value : Boolean); override;
    procedure SetDisplay(Value : TWinControl); override;
    procedure SetDisplayRect(Value : TRect); override;
    procedure SetSourceRect(Value : TRect); override;
    procedure SetDestinationRect(Value : TRect); override;
//    function GetCurrentImage : TBitmap;
  public
    { Public declarations }
    MediaPosition : IMediaPosition;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Open;
    procedure Close;
    procedure Play;
    procedure Stop;
    procedure Pause;
    function VideoWidth : Integer;
    function VideoHeight : Integer;
    property State : TRVMPModes read FState;
    property RenderVisible;
    property DisplayRect;
    property SourceRect;
    property DestinationRect;
  published
    { Published declarations }
    property Anchors;
    property Align;
    property Hint;
    property Enabled;
    property Color default clBlack;
    property Display;
    property DrawOnPrint;
    property FileName : String read FFileName write FFileName;
    property Height default 200;
    property ShowHint;
    property Visible;
    property TabStop default True;
    property Width default 320;
    property OnClick;
    property OnMouseMove;
    property OnMouseDown;
    property OnMouseUp;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnEnter;
    property OnExit;
    property OnDblClick;
    {$IFDEF RICHVIEWDEF5}
    property OnContextPopup;
    {$ENDIF}
    property OnMouseEnter;
    property OnMouseLeave;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('SRichView', [TSRVMediaPlayer]);
end;

constructor TSRVMediaPlayer.Create(AOwner: TComponent);
begin
  inherited;
    VideoWindow := nil;
    MediaPosition := nil;
    BasicVideo := nil;

    FState := rvmpNotReady;
    CoInitialize(nil);
end;

destructor TSRVMediaPlayer.Destroy;
begin
  Close;
//    if FState <> rvmpNotReady then
//      CoUninitialize;
  inherited;
end;

procedure TSRVMediaPlayer.Loaded;
begin
  inherited;
    FDisplayRect := Rect(0, 0, Width, Height);
end;

procedure TSRVMediaPlayer.Open;
var
     FN : array[0..1023] of WideChar;
begin
  {calling RenderFile - filter graph is built automatically}
  if not FileExists(FileName) then exit;
  Close;

  {acquiring IGraphBuilder interface}
  CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC_SERVER,
                   IID_IGraphBuilder, MyGraphBuilder);

  MyGraphBuilder.RenderFile(StringToWideChar(FileName, FN, 1024), nil);

  {acquiring ImediaControl interface}
  MyGraphBuilder.QueryInterface(IID_IMediaControl, MyMediaControl);
  {note - MyMediaControl: IMediaControl}

  {acquiring IID_IMediaPosition interface}
  MyGraphBuilder.QueryInterface(IID_IMediaPosition, MediaPosition);
  {note - MediaPosition: IMediaPosition}

  {acquiring IID_IBasicVideo interface}
  MyGraphBuilder.QueryInterface(IID_IBasicVideo, BasicVideo);
  {note - BasicVideo: IBasicVideo}

  {acquiring IVideoWindow interface}
  MyGraphBuilder.QueryInterface(IID_IVideoWindow, VideoWindow);
  {note - VideoWindow: IVideoWindow}

  {acquiring IMediaEvent interface}
  MyGraphBuilder.QueryInterface(IID_IMediaEvent, MediaEvent);
  {note - MediaEvent: IMediaEvent}

  {acquiring  IMediaEventEx interface}
  MyGraphBuilder.QueryInterface(IID_IMediaEventEx, MediaEventEx);
  {note - MediaEventEx: IMediaEventEx}

  {placing video window on the panel}
  if FDisplay = nil then
    begin
      VideoWindow.put_Owner(Handle);
//      VideoWindow.put_MessageDrain(Handle);
    end
  else
    begin
      VideoWindow.put_Owner(FDisplay.Handle);
//      VideoWindow.put_MessageDrain(FDisplay.Handle);
    end;

  VideoWindow.put_MessageDrain(Handle);

  VideoWindow.put_WindowStyle(WS_CHILD OR WS_CLIPSIBLINGS);
  VideoWindow.SetWindowPosition(FDisplayRect.Left, FDisplayRect.Top,
                                FDisplayRect.Right - FDisplayRect.Left,
                                FDisplayRect.Bottom - FDisplayRect.Top);

  FState := rvmpOpen;
end;

procedure TSRVMediaPlayer.Play;
begin
  {playing video}
  if (FState = rvmpNotReady) then exit;
  MyMediaControl.Run;

  FState := rvmpPlaying;
end;

procedure TSRVMediaPlayer.Stop;
begin
  if (FState = rvmpNotReady) then exit;
  MyMediaControl.Stop;
  FState := rvmpStopped;
end;

procedure TSRVMediaPlayer.Pause;
begin
  if (FState = rvmpNotReady) then exit;
  MyMediaControl.Pause;
  FState := rvmpPaused;
end;

procedure TSRVMediaPlayer.Close;
begin
  if (State = rvmpPlaying) or (State = rvmpPaused) then
    MyMediaControl.Stop;
//  CoUninitialize;
  FState := rvmpNotReady;
end;

function TSRVMediaPlayer.GetRenderVisible: Boolean;
var
     v : LongBool;
begin
  if VideoWindow = nil then v := False
  else VideoWindow.get_Visible(v);
  Result := v;
end;

procedure TSRVMediaPlayer.SetRenderVisible(Value : Boolean);
begin
  if VideoWindow = nil then exit;
  VideoWindow.put_Visible(Value);
end;

procedure TSRVMediaPlayer.SetDisplay(Value : TWinControl);
begin
  inherited;
  if VideoWindow <> nil then
    if Value = nil then
      begin
        VideoWindow.put_Owner(Handle);
//        VideoWindow.put_MessageDrain(Handle);
      end
    else
      begin
        VideoWindow.put_Owner(Value.Handle);
//        VideoWindow.put_MessageDrain(Value.Handle);
      end;
end;

procedure TSRVMediaPlayer.SetDisplayRect(Value : TRect);
begin
  inherited;
  if VideoWindow <> nil then
    VideoWindow.SetWindowPosition(Value.Left, Value.Top,
                                  Value.Right - Value.Left,
                                  Value.Bottom - Value.Top);
end;

procedure TSRVMediaPlayer.SetSourceRect(Value : TRect);
begin
  inherited;
  if BasicVideo <> nil then
    BasicVideo.SetSourcePosition(Value.Left, Value.Top,
                                 Value.Right - Value.Left,
                                 Value.Bottom - Value.Top);
end;

procedure TSRVMediaPlayer.SetDestinationRect(Value : TRect);
begin
  inherited;
  if BasicVideo <> nil then
    BasicVideo.SetDestinationPosition(Value.Left, Value.Top,
                                      Value.Right - Value.Left,
                                       Value.Bottom - Value.Top);
end;

function TSRVMediaPlayer.VideoWidth : Integer;
begin
  Result := 0;
  if BasicVideo <> nil then
    BasicVideo.get_VideoWidth(Result);
end;

function TSRVMediaPlayer.VideoHeight : Integer;
begin
  Result := 0;
  if BasicVideo <> nil then
    BasicVideo.get_VideoHeight(Result);
end;

{function TSRVMediaPlayer.GetCurrentImage : TBitmap;
var
     pDIBImage :
begin
  Result := TBitmap.Create;
  Result.Width := VideoWidth;
  Result.Height := VideoHeight;
//  CreateDIBitmap(Result.Canvas.Handle, nil, 0, );
  BasicVideo.GetCurrentImage(BufSize, pDIBImage);
end;}

end.
