Disable/overrule popop FNC maps

Hello,

Is it possible to disable the rightmouse popup menu in the FNCMap?
Or perhaps overrule it with an own popup menu. I have added a custom popup menu to the property but it does not seem to work.

image

Kind regards,
Michel Engeltjes

Hi,

You can disable the context menu with TMSFNCMaps1.EnableContextMenu := False; You cannot override the popupmenu, it is actually the popupmenu of the browser, not from the window of the application so customization is currently not possible. We'll investigate the possibilities.

Pieter,

So is there a way to do a popup menu on the displayed map? If I can see that it was a Right-Click on the map (browser) then I can launch the popup internally.

Setting the PopupMenu for the FNCMap doesn't work, as I think Michel was finding.

I can get around this by putting a button on the form above the map, but a true popup menu would be better.
Eric

Hi,

We still need to investigate the possibilities. We'll do this asap!

Hi,

We have investigated this here, and this involves a little bit of JavaScript, and a custom event handler registration. The sample below is based on TTMSFNCOpenLayers, but you can map this on TTMSFNCMaps as well. It is written in FMX, but you can do something similar in VCL as well.

unit Unit21;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.TMSFNCTypes, FMX.TMSFNCUtils, FMX.TMSFNCGraphics, FMX.TMSFNCGraphicsTypes,
  FMX.TMSFNCCustomControl, FMX.TMSFNCWebBrowser, FMX.TMSFNCMaps,
  FMX.TMSFNCOpenLayers, FMX.Menus;

type
  TForm21 = class(TForm)
    TMSFNCOpenLayers1: TTMSFNCOpenLayers;
    PopupMenu1: TPopupMenu;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    procedure TMSFNCOpenLayers1MapInitialized(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TMSFNCOpenLayers1CustomEvent(Sender: TObject;
      AEventData: TTMSFNCMapsEventData);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form21: TForm21;

implementation

{$R *.fmx}

procedure TForm21.FormCreate(Sender: TObject);
begin
  TMSFNCOpenLayers1.EnableContextMenu := False;
end;

procedure TForm21.TMSFNCOpenLayers1CustomEvent(Sender: TObject;
  AEventData: TTMSFNCMapsEventData);
var
  s: string;
  e: TTMSFNCMapsEventData;
  p: TPointF;
begin
  if AEventData.EventName = 'ContextMenuEvent' then
  begin
    e := TTMSFNCMapsEventData.Create;
    try
      e.JSON := AEventData.CustomData;
      p := TMSFNCOpenLayers1.LocalToScreen(PointF(e.X, e.Y));
      PopupMenu1.Popup(p.X, p.Y);
    finally
      e.Free;
    end;
  end;
end;

procedure TForm21.TMSFNCOpenLayers1MapInitialized(Sender: TObject);
const
  LB = #13#10;
var
  s: string;
begin
  s := 'function customContextMenu() {' + LB +
       '  document.addEventListener("contextmenu", function(e) {' + LB +
       '    var jsonObj = getDefaultEventDataObject();' + LB +
       '    jsonObj["X"] = e.offsetX;' + LB +
       '    jsonObj["Y"] = e.offsetY;' + LB +
       '    var r = {''EventName'': ''ContextMenuEvent''};' + LB +
       '    ' + GETSENDEVENT + '(r, jsonObj);' + LB +
       '  });' + LB +
       '} customContextMenu();';

  TMSFNCOpenLayers1.ExecuteJavascript(s);
end;

end.

Pieter,

This works. Thank you.
Here is my code with slight changes for VCL Google maps

Uses System.Types - for definition of "TPoint"

procedure TFNCMapForm.FNCMapCustomEvent(Sender: TObject;
AEventData: TTMSFNCMapsEventData);
var
s: string;
e: TTMSFNCMapsEventData;
p: TPoint; // <------- Change here
begin
if AEventData.EventName = 'PopupMenuEvent' then
begin
e := TTMSFNCMapsEventData.Create;
try
e.JSON := AEventData.CustomData;
p := FNCMap.ClientToScreen(Point(Round(e.X),Round(e.Y))); // <------- Change here
puMap.Popup(p.X, p.Y);
finally
e.Free;
end;
end;
end;

Pieter,
I spoke too soon.
This is for VCL FNC Google Maps
I can rt-click to launch my popup menu and then if I do nothing else (or even if I do) I'll get a debug message from within Delphi in about 24 seconds stating

Debug Output:
Running a message loop synchronously in an event handler in Webview can cause reentrancy issue. Please refer to Threading model for WebView2 - Microsoft Edge Development | Microsoft Docs for more information about threading model in WebView2 and how to enable native code debugging for this scenario.

Do you see this in your test program? If not, I'll try to write a small test program tomorrow that demonstrates this.

Hi,

Can you try with this code (add System.Threading)

procedure TForm14.TMSFNCOpenLayers1CustomEvent(Sender: TObject;
  AEventData: TTMSFNCMapsEventData);
var
  s: string;
  e: TTMSFNCMapsEventData;
  p: TPoint;
  t: ITask;
begin
  if AEventData.EventName = 'ContextMenuEvent' then
  begin
    e := TTMSFNCMapsEventData.Create;
    try
      e.JSON := AEventData.CustomData;
      p := TMSFNCOpenLayers1.ClientToScreen(Point(Round(e.X), Round(e.Y)));
      t := TTask.Create(
      procedure
      begin
        TThread.Synchronize(TThread.Current,
        procedure
        begin
          PopupMenu1.Popup(p.X, p.Y);
        end);
      end
      );
      t.Start;
    finally
      e.Free;
    end;
  end;
end;

Pieter,
Yes this is now working. I wasn't sure where to put in the Threading logic.

Thank you for your excellent support.
Eric

1 Like

Could the script be modified to show whether the mouse was clicked on a Marker or a PolyElement, please?

This is currently not possible, but we'll investigate the possibilities.