在Firemonkey

时间:2016-05-06 12:46:34

标签: delphi video media-player firemonkey capture

我想在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;  

有人可以帮助我吗?

1 个答案:

答案 0 :(得分:0)

这是一种可能的解决方法,仅适用于Windows / DirectShow。使用类帮助程序访问私有字段自Delphi 10.1柏林以来一直无法工作,所以在这种情况下你必须使用另一个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;