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

H Visli

Пользователи
  • Постов

    6
  • Зарегистрирован

  • Посещение

  • Победитель дней

    1

H Visli стал победителем дня 15 апреля 2020

H Visli имел наиболее популярный контент!

  1. @Alex7wrtCan you give me more info(or demo code) about your solution?
  2. 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;
  3. OK, I have basically located the cause of the problem, and the next step is how to fix this bug.
  4. 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. Can any guys can help me to fix this problem? Thanks a lot.
×
×
  • Создать...