Stacking FMX components over native elements

[CHackbart 13]

Hi,

 

i was trying to handle the following issue: I want to render FMX components over native components like the Webbrowser. To do so I wrote a TLayout class which has a transparent form. This form will be drawn over the original position. This works reasonably well under windows, but fails under MacOS. 

Technically I put the NSView of the new form in the context of the old form, but on top. This works fine, but all the elements are not clickable. Has somebody an idea how to solve this? For FMX.Media.Mac you can easily put the video in the context before the LFormView, like:

 

    LFormView := WindowHandleToPlatform(LForm.Handle).View;
    LContext := TNSView.Wrap(WindowHandleToPlatform(LForm.Handle).Wnd.contentView);
    LContext.addSubview(FVideoView);
    LContext.addSubview(LFormView);

 

unit FMX.LayoutForm;

interface

uses System.Classes, FMX.Types, FMX.Layouts, FMX.Forms
{$IFDEF MSWINDOWS}, Winapi.Windows, Winapi.Messages{$ENDIF};

type
  TVirtualLayout = class(TLayout)
  protected
    FView: TForm;
{$IFDEF MSWINDOWS}
    FObjectInstance: Pointer;
    FDefWindowProc: Pointer;
    FWndHandle: HWND;
    procedure MainWndProc(var Message: TMessage);
    procedure UpdateBounds;
{$ENDIF}
    procedure DoResized; override;
    procedure SetParent(const Value: TFmxObject); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy(); override;
  end;

implementation

uses System.Types
{$IFDEF MSWINDOWS}, FMX.Platform.Win {$ENDIF}
{$IFDEF MACOS}, Macapi.AppKit, FMX.Platform.Mac {$ENDIF};

constructor TVirtualLayout.Create(AOwner: TComponent);
begin
  inherited;
  FView := TForm.CreateNew(nil);
  FView.BorderStyle := TFmxFormBorderStyle.None;
  FView.Transparency := true;
  FView.Name := 'TOSDWindow';
end;

destructor TVirtualLayout.Destroy();
begin
{$IFDEF MSWINDOWS}
  if FDefWindowProc <> nil then
  begin
    SetWindowLong(FWndHandle, GWL_WNDPROC, IntPtr(FDefWindowProc));
    FDefWindowProc := nil;
  end;
  if FObjectInstance <> nil then
  begin
    FreeObjectInstance(FObjectInstance);
    FObjectInstance := nil;
  end;
{$ENDIF}
  inherited;
end;

{$IFDEF MSWINDOWS}

procedure TVirtualLayout.UpdateBounds;
var
  LForm: TCommonCustomForm;
  R: TRectF;
begin
  if FView.Parent is TCommonCustomForm then
  begin
    LForm := TCommonCustomForm(FView.Parent);
    R := LForm.ClientRect;
    R.Offset(LForm.ClientToScreen(PointF(0, 0)));
    FView.SetBoundsF(R);
  end;
end;

procedure TVirtualLayout.MainWndProc(var Message: TMessage);
begin
  if Root.GetObject is TCommonCustomForm then
  begin
    if Message.Msg = WM_MOVE then
    begin
      UpdateBounds;
    end;
    if (Message.Result = 0) then
      TCommonCustomForm(Root.GetObject).Dispatch(Message);

    with Message do
    begin
      if Result = 0 then
        Result := CallWindowProc(FDefWindowProc, FWndHandle, Msg,
          WParam, LParam);
    end;
  end;
end;
{$ENDIF}

procedure TVirtualLayout.SetParent(const Value: TFmxObject);
begin
  inherited;

{$IFDEF MSWINDOWS}
  FreeObjectInstance(FObjectInstance);
  FObjectInstance := nil;
  DoResized;
{$ENDIF}
end;

procedure TVirtualLayout.DoResized;
var
  LForm: TCommonCustomForm;
{$IFDEF MACOS}
  LVideoView: NSView;
  LFormView: NSView;
  LContext: NSView;
{$ENDIF}
  i: integer;
begin
  inherited;

  if not(csDesigning in ComponentState) and (ParentedVisible) and (Root <> nil)
    and (Root.GetObject is TCommonCustomForm) then
  begin
    for i := ChildrenCount - 1 downto 0 do
      if (Children[i].Name <> '') then
        Children[i].Parent := FView;

    LForm := TCommonCustomForm(Root.GetObject);

    FView.Visible := true;
    FView.StyleBook := LForm.StyleBook;
    FView.OnKeyUp := LForm.OnKeyUp;
    FView.OnKeyDown := LForm.OnKeyDown;
    FView.OnMouseDown := LForm.OnMouseDown;
    FView.OnMouseMove := LForm.OnMouseMove;
    FView.OnMouseUp := LForm.OnMouseUp;
    FView.OnMouseWheel := LForm.OnMouseWheel;

{$IFDEF MACOS}
    LFormView := WindowHandleToPlatform(LForm.Handle).View;
    LVideoView := WindowHandleToPlatform(FView.Handle).View;
    LContext := TNSView.Wrap(WindowHandleToPlatform(LForm.Handle)
      .Wnd.contentView);
    LContext.addSubview(LFormView);
    LContext.addSubview(LVideoView);
{$ENDIF}
{$IFDEF MSWINDOWS}
    if FObjectInstance = nil then
    begin
      FObjectInstance := MakeObjectInstance(MainWndProc);
      if FObjectInstance <> nil then
      begin
        FWndHandle := WindowHandleToPlatform(LForm.Handle).Wnd;
        FDefWindowProc := Pointer(GetWindowLong(FWndHandle, GWL_WNDPROC));
        SetWindowLong(FWndHandle, GWL_WNDPROC, IntPtr(FObjectInstance));
      end;
    end;
{$ENDIF}
  end
  else
  begin
    for i := FView.ChildrenCount - 1 downto 0 do
      if (FView.Children[i].Name <> '') then
        FView.Children[i].Parent := self;

    FView.Parent := nil;

    FView.Visible := false;
  end;
end;

end.

 

 

[Dave Nottage 563]

It looks like you're taking a fairly different approach, however you may be interested in voting for this issue: https://quality.embarcadero.com/browse/RSP-38988. (which would be one way of solving your problem)

[CHackbart 13]

Hi, thanks I voted for your issue - even if I am not sure if it helps. I would love to test that, but I assume it probably won't work in my case.

The project I am working is an iptv application which heavily uses DRM, so I was forced to use the AVFoundation classes under MacOS and since Microsoft somehow did not support Playready properly for Win32/Win64 I was forced to use Widevine in combination with Edge as player under windows.

Both are working fine but suck when you try to use FMX controls on top as overlay. Since I use a browser under windows, I thought it might be cool to add HbbTV (some sort of interactive content for tv) to the streams and after I got this working I thought it would be nice to have this also running on a Mac.

[Dave Nottage 563]

10 minutes ago, CHackbart said:

I assume it probably won't work in my case

Actually, it probably will. I already overlay things like TMapView and TWebBrowser, using the "native" controls in the Kastri repo: https://github.com/DelphiWorlds/Kastri/blob/master/Controls/NativeControls.md.

 

The part that's missing is macOS support. 

[CHackbart 13]

I think you are right, I read a bit about the TControlType. In theory I could put a TPanel as parent of my OSD on top of the browser/video player. This works on Windows, for Mac I move the browser/video view in the context video and not the form nsview.

Anyhow this works at the moment here, but I have to figure out how to hook WM_ERASEBKGND for the panel in order to make it transparent, 

 

Cheers

Christian 

Edited November 23, 2022 by CHackbart