H Visli

Has anyone solved this problem?

В 3/3/2016 в 4:54 AM, Alex7wrt сказал:

I solved the problem using the timer and getcursorpos () and getasynckeystate () functions.

@Alex7wrtCan you give me more info(or demo code) about your solution?

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;

OK, I have basically located the cause of the problem, and the next step is how to fix this bug. 

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.