capture bitmap from playing video (TMediaPlayer) on Firemonkey

Question

I want to capture bitmap from playing video (TMediaPlayer) on Firemonkey but i get only black image.

I use this: https://sourceforge.net/p/radstudiodemos/code/HEAD/tree/branches/RadStudio_XE5_Update/FireMonkey/Delphi/MediaPlayerHD/
and adding this:

procedure TForm240.Button1Click(Sender: TObject);
begin
  MediaPlayerControl1.MakeScreenshot.SaveToFile('d:\nic.bmp');
end;  

Can someone help me?

Answer 1

Here's a possible work-around, for Windows/DirectShow only. Using a class helper to access private fields won't work since Delphi 10.1 Berlin so in that case you have to use another hack.

uses
{$IFDEF MSWINDOWS}
  FMX.Helpers.Win,
  FMX.Media.Win,
  Winapi.ActiveX,
  Winapi.DirectShow9,
{$ENDIF}
  FMX.Surfaces;

{$IFDEF MSWINDOWS}
type
  TMediaPlayerHelper = class helper for FMX.Media.TMediaPlayer
  public
    function MakeScreenshot: TBitmap;
  end;

  TWindowsMediaHelper = class helper for FMX.Media.Win.TWindowsMedia
  public
    function MakeScreenshot: TBitmap;
  end;

function TWindowsMediaHelper.MakeScreenshot: TBitmap;
var
  P: PByte;
  Surface: TBitmapSurface;
  Stream: TMemoryStream;
begin
  Result := nil;

  Surface := nil;
  Stream := nil;
  try
    Self.FVMRWindowlessControl.GetCurrentImage(P);
    try
      Surface := DIBDataToBitmapSurface(P);
    finally
      CoTaskMemFree(P);
    end;

    Stream := TMemoryStream.Create;
    TBitmapCodecManager.SaveToStream(Stream, Surface, '.bmp');
    FreeAndNil(Surface);

    Stream.Seek(0, soBeginning);
    Result := TBitmap.Create;
    try
      Result.LoadFromStream(Stream);
    except
      Result.Free;
      raise;
    end;
  finally
    Stream.Free;
    Surface.Free;
  end;
end;

function TMediaPlayerHelper.MakeScreenshot: TBitmap;
begin
  Result := (Self.Media as TWindowsMedia).MakeScreenshot;
end;
{$ENDIF}

procedure TForm240.Button1Click(Sender: TObject);
begin
  MediaPlayer1.MakeScreenshot.SaveToFile('d:\nic.bmp');
end;