Mediaplayer Firemonkey

[hathor]

Da gibt es was:

Delphi-Quellcode:

uses ... FMX.Media.Win,..., mediaPlayerStretchFix;

procedure TfrmMain.Button2Click(Sender: TObject);
var mp: TWindowsMedia;
   filename : String;
begin
filename:= 'F:\_ForExportOnly\SDXC64\TEST6.mp4'; // DEIN Videofile !
  mp:= TWindowsMedia.create(filename);
  mp.Control:= MediaPlayerControl1; 
  mp.Play;
  mp.Stretch; // <--------------
end;

---------------------

Delphi-Quellcode:

unit mediaPlayerStretchFix;  //20150927

interface

uses  Winapi.Windows, FMX.Platform.Win, FMX.Media.Win, FMX.Forms, System.Types,
      FMX.controls, System.Classes, Directshow9;

type

  TMediaPlayerTurbo = class helper for TWindowsMedia
  private
    function getFWnd: HWND;
    function getFControl: TControl;
    function getVMRWC: IVMRWindowlessControl9;
    property leFWnd:HWND read getFWnd;
    property leControl:TControl read getFControl;
    property leFVMRWindowlessControl:IVMRWindowlessControl9 read getVMRWC;
  public
    procedure Stretch;
  end;

implementation

procedure TMediaPlayerTurbo.Stretch;
var
  P: TPointF;
  R: TRect;
  Bounds: TRectF;
  Form: TCommonCustomForm;
  // this is just an updated version of TRecF.Fit to support scaling up
  function MyRectFit(var R: TRectF; const BoundsRect: TRectF): Single;
  var ratio: Single;
  begin
    Result := 1;
    if BoundsRect.Width * BoundsRect.Height = 0 then Exit;
    if (R.Width / BoundsRect.Width) > (R.Height / BoundsRect.Height) then
      ratio := R.Width / BoundsRect.Width
    else
      ratio := R.Height / BoundsRect.Height;
    // UPDATED
    R := RectF(0, 0, R.Width / ratio, R.Height / ratio);
    Result := ratio;
    RectCenter(R, BoundsRect);
  end;

begin
  if leFWnd <> 0 then
  begin
    if (leControl <> nil) and not(csDesigning in Control.ComponentState) and
      (Control.ParentedVisible) and (Control.Root <> nil) and
      (Control.Root.GetObject is TCommonCustomForm) then
    begin
      Form := TCommonCustomForm(Control.Root.GetObject);
      P := self.GetVideoSize;
      Bounds := TRectF.Create(0, 0, P.X, P.Y);
      // UPDATED: Bounds.Fit(RectF(0, 0, Control.AbsoluteWidth, Control.AbsoluteHeight));
      MyRectFit(Bounds, RectF(0, 0, Control.AbsoluteWidth, Control.AbsoluteHeight));
      Bounds.Offset(Control.AbsoluteRect.Left, Control.AbsoluteRect.Top);
      SetParent(leFWnd, FmxHandleToHWND(Form.Handle));
      SetWindowPos(leFWnd, 0, Bounds.Round.Left, Bounds.Round.Top, Bounds.Round.Width,
                   Bounds.Round.Height, 0);
      R.Create(0, 0, Bounds.Round.Width, Bounds.Round.Height);
      if leFVMRWindowlessControl <> nil then
        leFVMRWindowlessControl.SetVideoPosition(nil, @R);
      ShowWindow(leFWnd, SW_SHOW)
    end
    else
      ShowWindow(leFWnd, SW_HIDE)
  end;
end;

function TMediaPlayerTurbo.getFControl: TControl;
begin result:=TControl(fCOntrol); end;

function TMediaPlayerTurbo.getFWnd: HWND;
begin result:=self.fWnd; end;

function TMediaPlayerTurbo.getVMRWC: IVMRWindowlessControl9;
begin result:=self.FVMRWindowlessControl; end;

end.