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.
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.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
TMSFNCOpenLayers1.EnableContextMenu := False;
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.
I tried to use this approach, but it failed. The simple code
TMSFNCOpenLayers1.EnableContextMenu := False; does not work because in VCL.TMSFNCWebBrowser.Win.pas (line 2947) the clause if Assigned(FWebBrowserWebView2) returns False since FWebBrowserWebView2 is nil.
I updated the code, we recently changed the behavior of the browser from synchronous to asynchronous. Please check the code again and move TMSFNCOpenLayers1.EnableContextMenu := False; to the OnMapInitialized event.
Thank you ... popup works, but TMSFNCOpenLayers1.LocalToScreen(PointF(e.X, e.Y)); seems not to be implemented for VCL. Am I wrong?
For VCL, it's ClientToScreen