unit sensoredgemap; { GPS Location API component sample application Updated by Angus Robertson, Magenta Systems Ltd, England, 21st January 2022 delphi@magsys.co.uk, https://www.magsys.co.uk/delphi/ Copyright Magenta Systems Ltd Display a Google map to plot GPS locations. This unit is for Delphi 10.4 Sydney and later ujsing the TEdgeBrowser component, for earlier Delphi version use sensormap.pas which uses the TWebBrowser component instead, but with Windows 11 now tries to emulate a much older version of MSIE with Google Maps saying is a obsolete browser. } interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, OleCtrls, ExtCtrls, ActiveX, IniFiles, magsubs4, Winapi.WebView2, Vcl.Edge; const WM_MAP_UPDATE = WM_USER + 321 ; type TFormMap = class(TForm) Panel1: TPanel; doClose: TButton; EditAddr: TEdit; doAddress: TButton; CheckRealTime: TCheckBox; doClear: TButton; LabelUpdate: TLabel; CheckRoute: TCheckBox; EdgeBrowser: TEdgeBrowser; procedure doCloseClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure doAddressClick(Sender: TObject); procedure CheckRealTimeClick(Sender: TObject); procedure doClearClick(Sender: TObject); procedure EdgeBrowserCreateWebViewCompleted(Sender: TCustomEdgeBrowser; AResult: HRESULT); private { Private declarations } // HTMLWindow2: IHTMLWindow2; procedure WMMAPUPDATE(var Msg : TMessage); message WM_MAP_UPDATE ; public { Public declarations } procedure PlotLatLong; end; var FormMap: TFormMap; PendingLatLong: boolean = false ; const // warning marker icon fails, so temporarily removed HTMLStr: AnsiString = ' '+#13#10+ ' '+#13#10+ ' '+#13#10+ ''+#13#10+ ' '+#13#10+ ' '+#13#10+ ''+#13#10+ //' '+#13#10+ ' '+#13#10+ '
'+#13#10+ '
'+#13#10+ ' '+#13#10+ ' '+#13#10+ '
'+#13#10+ ''+#13#10+ ' '+#13#10+ ' '+#13#10; implementation {$R *.dfm} uses sensormain ; procedure TFormMap.FormCreate(Sender: TObject); var IniFile : TMemIniFile; EdgeCacheDir: String; begin IniFile := TMemIniFile.Create(FIniFileName); with IniFile do begin Top := ReadInteger ('MapWindow', 'Top', (Screen.Height - Height) div 2); Left := ReadInteger ('MapWindow', 'Left', (Screen.Width - Width) div 2); Width := ReadInteger ('MapWindow', 'Width', Width); Height := ReadInteger ('MapWindow', 'Height', Height); end; IniFile.Free; FormMain.Log.Lines.Add ('EdgeBrowserCreate') ; EdgeCacheDir := ExtractFilePath(FIniFileName) + '\EdgeCache'; ForceDirectories(EdgeCacheDir); EdgeBrowser.UserDataFolder := EdgeCacheDir; EdgeBrowser.CreateWebView; end; procedure TFormMap.FormClose(Sender: TObject; var Action: TCloseAction); var IniFile : TMemIniFile; begin MapOpenFlag := false ; Action := caFree ; IniFile := TMemIniFile.Create(FIniFileName); with IniFile do begin WriteInteger ('Window', 'Top', Top); WriteInteger ('Window', 'Left', Left); WriteInteger ('Window', 'Width', Width); WriteInteger ('Window', 'Height', Height); end ; IniFile.UpdateFile; IniFile.Free; end; procedure TFormMap.WMMAPUPDATE(var Msg : TMessage); begin PlotLatLong; end; procedure TFormMap.PlotLatLong; begin if NOT MapOpenFlag then exit ; if (MagGpsLoc.Latitude = 0) and (MagGpsLoc.Longitude = 0) then exit ; PendingLatLong := false ; FormMain.Log.Lines.Add ('EdgeBrowserPlotLatLong - Plot on Map') ; if NOT CheckRoute.Checked then doClearClick (self) ; try EdgeBrowser.ExecuteScript('GotoLatLng (' + Double2EStr (MagGpsLoc.Latitude, 6) + ',' + Double2EStr (MagGpsLoc.Longitude, 6) + ',"' + TimeToStr (Time) + '")') ; except FormMain.Log.Lines.Add ('Failed ExecScript GotoLatLng'); end; end; procedure TFormMap.CheckRealTimeClick(Sender: TObject); begin if CheckRealTime.Checked then begin doClearClick (self) ; PlotLatLong; end; end; procedure TFormMap.doAddressClick(Sender: TObject); var Addr: string; begin CheckRealTime.Checked := false ; doClearClick (self) ; Addr := EditAddr.Text ; Addr := StringReplace (StringReplace (Trim(Addr), #13, ' ', [rfReplaceAll]), #10, ' ', [rfReplaceAll]) ; try EdgeBrowser.ExecuteScript ('codeAddress (' + QuotedStr (Addr) + ')') ; except FormMain.Log.Lines.Add ('Failed ExecScript codeAddres'); end; end; procedure TFormMap.doClearClick(Sender: TObject); begin try EdgeBrowser.ExecuteScript ('ClearMarkers()') except FormMain.Log.Lines.Add ('Failed ExecScript ClearMarkers'); end; end; procedure TFormMap.doCloseClick(Sender: TObject); begin EdgeBrowser.CloseWebView; Close ; end; procedure TFormMap.EdgeBrowserCreateWebViewCompleted(Sender: TCustomEdgeBrowser; AResult: HRESULT); begin FormMain.Log.Lines.Add ('EdgeBrowser WebView Completed: ' + IntToStr(AResult)); if NOT EdgeBrowser.NavigateToString(HTMLStr) then FormMain.Log.Lines.Add ('EdgeBrowser-NavigatetoString Failed') else if PendingLatLong then begin PendingLatLong := false ; PostMessage (Handle, WM_MAP_UPDATE, 0, 0) ; exit ; end; end; end.