Question

我有一个简单的自定义浏览器，显示一个工作正常的谷歌地图。我想要做的是使它成为一个转弯键形式，显示个人打开时的位置并将其绘制在地图上。

这是一个证明这个概念的小测试程序。

如果我通过显示表单并将值添加到编辑框并运行ButtonGotoLocation过程来添加位置，则每次都有效。

如果我将其设置为交钥匙系统，即调用HTMLWindow2.execScript(Format('GotoLatLng(%s,%s)',['34','-84.00']), 'JavaScript');

我甚至尝试创建表单并显示它，然后从调用表单调用一个过程。相同的结果;

这是一个奇怪的并发问题吗？这就是我使用外部程序但无济于事的原因。

unit uStreetMap;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, StdCtrls, ExtCtrls, XPMan, ComCtrls,MSHTML;

type
  TfrmMain = class(TForm)
    WebBrowser1: TWebBrowser;
    LabelAddress: TLabel;
    PanelHeader: TPanel;
    ButtonGotoLocation: TButton;
    XPManifest1: TXPManifest;
    MemoAddress: TMemo;
    ButtonGotoAddress: TButton;
    LabelLatitude: TLabel;
    LabelLongitude: TLabel;
    Longitude: TEdit;
    Latitude: TEdit;
    ButtonClearMarkers: TButton;

    procedure FormCreate(Sender: TObject);
    procedure ButtonGotoAddressClick(Sender: TObject);
    procedure ButtonGotoLocationClick(Sender: TObject);
    procedure ButtonClearMarkersClick(Sender: TObject);

    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
    HTMLWindow2: IHTMLWindow2;
    function UTCToSystemTime(UTC: TDateTime): TDateTime;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses
   ActiveX, DateUtils;


{$R *.dfm}

const
HTMLStr: AnsiString =
'<html> '+
'<head> '+
'<meta name="viewport" content="initial-scale=1.0, user-scalable=yes" /> '+
'<script type="text/javascript" src="https://maps.googleapis.com/maps/api/js?v=3.24&amp;libraries=geometry"></script> '+
'<script type="text/javascript"> '+
''+
''+
'  var geocoder; '+
'  var map;  '+
'  var markersArray = [];'+
''+
''+
'  function initialize() { '+
'    geocoder = new google.maps.Geocoder();'+
'    var latlng = new google.maps.LatLng(40.714776,-74.019213); '+
'    var myOptions = { '+
'      zoom: 13, '+
'      center: latlng, '+
'      mapTypeId: google.maps.MapTypeId.ROADMAP '+
'    }; '+
'    map = new google.maps.Map(document.getElementById("map_canvas"), myOptions); '+
'    map.set("streetViewControl", false);'+
'  } '+
''+
''+
'  function codeAddress(address) { '+
'    if (geocoder) {'+
'      geocoder.geocode( { address: address}, function(results, status) { '+
'        if (status == google.maps.GeocoderStatus.OK) {'+
'          map.setCenter(results[0].geometry.location);'+
'          PutMarker(results[0].geometry.location.lat(), results[0].geometry.location.lng(), results[0].geometry.location.lat()+","+results[0].geometry.location.lng());'+
'        } else {'+
'          alert("Geocode was not successful for the following reason: " + status);'+
'        }'+
'      });'+
'    }'+
'  }'+
''+
''+
'  function GotoLatLng(Lat, Lang) { '+
'   var latlng = new google.maps.LatLng(Lat,Lang);'+
'   map.setCenter(latlng);'+
'   PutMarker(Lat, Lang, Lat+","+Lang);'+
'  }'+
''+
''+
'function ClearMarkers() {  '+
'  if (markersArray) {        '+
'    for (i in markersArray) {  '+
'      markersArray[i].setMap(null); '+
'    } '+
'  } '+
'}  '+
''+
'  function PutMarker(Lat, Lang, Msg) { '+
'   var latlng = new google.maps.LatLng(Lat,Lang);'+
'   var marker = new google.maps.Marker({'+
'      position: latlng, '+
'      map: map,'+
'      title: Msg+" ("+Lat+","+Lang+")"'+
'  });'+
' markersArray.push(marker); '+
'  }'+
''+
''+
''+'</script> '+
'</head> '+
'<body onload="initialize()"> '+
'  <div id="map_canvas" style="width:100%; height:100%"></div> '+
'</body> '+
'</html> ';

这导致异常，因为脚本错误'GotoLatLng'未定义

procedure TfrmMain.FormActivate(Sender: TObject);
begin
   HTMLWindow2.execScript(Format('GotoLatLng(%s,%s)',['34.00','-84.00']), 'JavaScript');
end;

构造

procedure TfrmMain.FormCreate(Sender: TObject);
var
  aStream     : TMemoryStream;
begin
   WebBrowser1.Navigate('about:blank');
    if Assigned(WebBrowser1.Document) then
    begin
      aStream := TMemoryStream.Create;
      try
         aStream.WriteBuffer(Pointer(HTMLStr)^, Length(HTMLStr));
         aStream.Seek(0, soFromBeginning);
         (WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(aStream));
      finally
         aStream.Free;
      end;
      HTMLWindow2 := (WebBrowser1.Document as IHTMLDocument2).parentWindow;

    end;
end;

使用此程序可以正常工作。我在文本框中输入Lat / Lng并单击按钮，一切正常。

procedure TfrmMain.ButtonGotoLocationClick(Sender: TObject);
begin
   HTMLWindow2.execScript(Format('GotoLatLng(%s,%s)',[Latitude.Text,Longitude.Text]), 'JavaScript');
end;

但如果我尝试让表单在地图上显示位置（作为转折键），我会收到错误。

procedure TfrmMain.ButtonClearMarkersClick(Sender: TObject);
begin
  HTMLWindow2.execScript('ClearMarkers()', 'JavaScript')
end;

procedure TfrmMain.ButtonGotoAddressClick(Sender: TObject);
var
   address    : string;
begin
   address := MemoAddress.Lines.Text;
   address := StringReplace(StringReplace(Trim(address), #13, ' ', [rfReplaceAll]), #10, ' ', [rfReplaceAll]);
   HTMLWindow2.execScript(Format('codeAddress(%s)',[QuotedStr(address)]), 'JavaScript');
end;


end.

Answer 1

好的，这就是我做的。我在表单上抛出一个TTimer来执行脚本来调用GotoLatLng。由于我找不到使用WaitForSingleObject信号的句柄，这是我能做的最好的。我把它设置为1700毫秒，似乎是足够的时间。我还将Map创建移出单元构造函数并移动到Form Constructor中。

一切都很好。

无法将地图上的位置绘制为交钥匙系统

1 个答案: