從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。從德爾福10.1柏林開始，使用類助手訪問私有字段將不起作用，因此在這種情況下，您必須使用另一種黑客技術。

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;