Перейти к содержанию
Fire Monkey от А до Я
  • 0

Can't stretch the video under the 2K / 4K screen


H Visli

Вопрос

My program need to play videos with full screen and run under 4k monitor (Windows 10 64bit, Firemonkey framework).


I found a post which fixing the TMediaPlayer scaling problem by @ Brovin yaroslav  and @ cezif

It works very fine under 1080p monitor (1920x1080).

But when I run my program under 4k monitor(3840x2160), the video can't been stretched with correct display.

mediaplay.thumb.png.b1465dd80ca224579aa4435eb40da8c9.png

Can any guys can help me to fix this problem? Thanks a lot.

Изменено пользователем H Visli
Ссылка на комментарий

Рекомендуемые сообщения

  • 0

Finally solved. Although it is not perfect, but it can satisfy my use. Share to everyone: 

(Base on @ Brovin yaroslav  and @ cezif  's post, Thanks!)

procedure TWindowsMedia.UpdateMediaFromControl;
  function GetScreenScale: Single;
  var
    ScreenService: IFMXScreenService;
  begin
    Result := 1;
    if TPlatformServices.Current.SupportsPlatformService (IFMXScreenService, IInterface(ScreenService)) then
      Result := ScreenService.GetScreenScale;
  end;
var
  R: TRect;
  Bounds: TRectF;
  Form: TCommonCustomForm;
  ScaleRatio: Single;
begin
  FVMRWindowlessControl9.SetAspectRatioMode(VMR9ARMode_LetterBox);
  if FWnd <> 0 then
  begin
    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);
      ScaleRatio := GetScreenScale;
      Bounds := TRectF.Create(0, 0, Control.AbsoluteWidth * ScaleRatio, Control.AbsoluteHeight * ScaleRatio);
      Bounds.Fit(RectF(0, 0, Control.AbsoluteWidth * ScaleRatio, Control.AbsoluteHeight * ScaleRatio));
      Bounds.Offset(Control.AbsoluteRect.Left, Control.AbsoluteRect.Top);
      SetParent(FWnd, WindowHandleToPlatform(Form.Handle).Wnd);
      SetWindowPos(FWnd, 0, Bounds.Round.Left, Bounds.Round.Top, Bounds.Round.Width, Bounds.Round.Height, 0);
      R := TRect.Create(0, 0, Bounds.Round.Width, Bounds.Round.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;
end;

 

Изменено пользователем H Visli
Ссылка на комментарий

Присоединяйтесь к обсуждению

Вы можете написать сейчас и зарегистрироваться позже. Если у вас есть аккаунт, авторизуйтесь, чтобы опубликовать от имени своего аккаунта.

Гость
Ответить на вопрос...

×   Вставлено с форматированием.   Вставить как обычный текст

  Разрешено использовать не более 75 эмодзи.

×   Ваша ссылка была автоматически встроена.   Отображать как обычную ссылку

×   Ваш предыдущий контент был восстановлен.   Очистить редактор

×   Вы не можете вставлять изображения напрямую. Загружайте или вставляйте изображения по ссылке.

  • Последние посетители   0 пользователей онлайн

    • Ни одного зарегистрированного пользователя не просматривает данную страницу
×
×
  • Создать...