从 Firemonkey 上播放视频 (TMediaPlayer) 捕获位图

Question

我想从在 Firemonkey 上播放视频 (TMediaPlayer) 时捕获位图但我只得到黑色图像。

我用这个： https://sourceforge.net/p/radstudiodemos/code/HEAD/tree/branches/RadStudio_XE5_Update/FireMonkey/Delphi/MediaPlayerHD/
并添加：

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

有人可以帮助我吗？

Answer 1

这是一个可能的解决方法，仅适用于 Windows/DirectShow。自 Delphi 10.1 Berlin 起，使用 class 助手访问私有字段将无法正常工作，因此在这种情况下，您必须使用另一个 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;

从 Firemonkey 上播放视频 (TMediaPlayer) 捕获位图

capture bitmap from playing video (TMediaPlayer) on Firemonkey

delphi

video

capture

media-player

firemonkey