【Delphi】FireMonkey の TMediaPlayer で低解像度動画をアップスケールする

はじめに

FireMonkey の TMediaPlayer で低解像度の動画を再生しようとすると、画面の中央に小さく表示されてしまいます。高解像度の動画を再生した時には縮小されますが、拡大はされないようです。

See also:

• RSP-15297 TMediaPLayer STILL CANNOT RESIZE AFTER 5 YEARS !!!! (Quality Portal)

解決方法

Stackoverflow に回避策が提示されています。

• TMediaPlayerControl Video Size (Stackoverflow)

ちょっと解りにくいですが、つまりはこういう事です (Windows の場合):

　1. 自分のプロジェクトに FMX.Media.Win.pas をコピーしてくる。
　2. TWindowsMedia クラスの UpdateMediaFromControl メソッドを書き換える。
　3. プロジェクトを再コンパイル。

10.4 Sydney の場合、UpdateMediaFromControl メソッドは次のようになるかと思います。

FMX.Media.Win.pas

procedure TWindowsMedia.UpdateMediaFromControl;
var
  P: TPointF;
  R: TRect;
  Bounds: TRectF;
  Form: TCommonCustomForm;
  BoundsInt: TRect;

  { ADD begin }
  // 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;
  { ADD end }

begin
  if FWnd = 0 then
    Exit;

  if (Control <> 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 := GetVideoSize;
    Bounds := TRectF.Create(0, 0, P.X, P.Y);
//  Bounds.Fit(TRectF.Create(0, 0, Control.AbsoluteWidth, Control.AbsoluteHeight)); // MOD
    MyRectFit(Bounds, RectF(0, 0, Control.AbsoluteWidth, Control.AbsoluteHeight));  // MOD
    Bounds.Offset(Control.AbsoluteRect.Left, Control.AbsoluteRect.Top);
    SetParent(FWnd, WindowHandleToPlatform(Form.Handle).Wnd);

    BoundsInt := Bounds.Round;
    SetWindowPos(FWnd, 0, BoundsInt.Left, BoundsInt.Top, BoundsInt.Width, BoundsInt.Height, 0);

    R := TRect.Create(0, 0, BoundsInt.Width, BoundsInt.Height);
    if FVMRWindowlessControl9 <> nil then
      FVMRWindowlessControl9.SetVideoPosition(nil, @R);
    if FVMRWindowlessControl7 <> nil then
      FVMRWindowlessControl7.SetVideoPosition(nil, @R);
    ShowWindow(FWnd, SW_SHOW)
  end
  else
  begin
    SetParent(FWnd, ApplicationHWND);
    ShowWindow(FWnd, SW_HIDE)
  end;
end;

おわりに

確かにストレッチのプロパティくらいはあってもよさそうです。