From 5c2ed7f07a6e5566364ed8c636f65124797bc478 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 30 Apr 2019 22:22:18 +0000 Subject: [PATCH] lazmapviewer: Add HERE maps (registration required). git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6887 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../lazmapviewer/example/MapViewer_Demo.lpi | 9 ++-- components/lazmapviewer/example/main.lfm | 8 +++- components/lazmapviewer/example/main.pas | 24 +++++++++- components/lazmapviewer/source/mvdlefpc.pas | 16 ++++++- components/lazmapviewer/source/mvengine.pas | 45 ++++++++++++++++++- 5 files changed, 91 insertions(+), 11 deletions(-) diff --git a/components/lazmapviewer/example/MapViewer_Demo.lpi b/components/lazmapviewer/example/MapViewer_Demo.lpi index cfca6c097..d82e34e8e 100644 --- a/components/lazmapviewer/example/MapViewer_Demo.lpi +++ b/components/lazmapviewer/example/MapViewer_Demo.lpi @@ -26,13 +26,16 @@ - + - + - + + + + diff --git a/components/lazmapviewer/example/main.lfm b/components/lazmapviewer/example/main.lfm index b3a2b9091..eee53c3a0 100644 --- a/components/lazmapviewer/example/main.lfm +++ b/components/lazmapviewer/example/main.lfm @@ -89,7 +89,7 @@ object MainForm: TMainForm Height = 40 Top = 59 Width = 207 - Max = 17 + Max = 19 Min = 1 OnChange = ZoomTrackBarChange Position = 1 @@ -617,7 +617,7 @@ object MainForm: TMainForm Align = alClient CacheOnDisk = True CachePath = 'cache/' - DownloadEngine = MapView.BuiltIn + DownloadEngine = MVDESynapse1 InactiveColor = clWhite MapProvider = 'OpenStreetMap Mapnik' UseThreads = True @@ -634,4 +634,8 @@ object MainForm: TMainForm left = 328 top = 224 end + object MVDESynapse1: TMVDESynapse + left = 347 + top = 131 + end end diff --git a/components/lazmapviewer/example/main.pas b/components/lazmapviewer/example/main.pas index cc547b536..1b9fbca19 100644 --- a/components/lazmapviewer/example/main.pas +++ b/components/lazmapviewer/example/main.pas @@ -7,7 +7,7 @@ interface uses Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, ComCtrls, Buttons, - mvGeoNames, mvMapViewer, mvTypes, mvGpsObj; + mvGeoNames, mvMapViewer, mvTypes, mvGpsObj, mvDLESynapse; type @@ -49,6 +49,7 @@ type ControlPanel: TPanel; BtnLoadMapProviders: TSpeedButton; BtnSaveMapProviders: TSpeedButton; + MVDESynapse1: TMVDESynapse; ZoomTrackBar: TTrackBar; procedure BtnGoToClick(Sender: TObject); procedure BtnSearchClick(Sender: TObject); @@ -419,6 +420,14 @@ var begin ini := TMemIniFile.Create(CalcIniName); try + HERE_AppID := ini.ReadString('HERE', 'APP_ID', ''); + HERE_AppCode := ini.ReadString('HERE', 'APP_CODE', ''); + if (HERE_AppID <> '') and (HERE_AppCode <> '') then begin + MapView.Engine.ClearMapProviders; + MapView.Engine.RegisterProviders; + MapView.GetMapProviders(CbProviders.Items); + end; + R := Screen.DesktopRect; L := ini.ReadInteger('MainForm', 'Left', Left); T := ini.ReadInteger('MainForm', 'Top', Top); @@ -430,8 +439,14 @@ begin if T < R.Top then T := R.Top; SetBounds(L, T, W, H); - MapView.MapProvider := ini.ReadString('MapView', 'Provider', MapView.MapProvider); + s := ini.ReadString('MapView', 'Provider', MapView.MapProvider); + if CbProviders.Items.IndexOf(s) = -1 then begin + MessageDlg('Map provider "' + s + '" not found.', mtError, [mbOK], 0); + s := CbProviders.Items[0]; + end; + MapView.MapProvider := s; CbProviders.Text := MapView.MapProvider; + MapView.Zoom := ini.ReadInteger('MapView', 'Zoom', MapView.Zoom); pt.Lon := StrToFloatDef(ini.ReadString('MapView', 'Center.Longitude', ''), 0.0, PointFormatSettings); pt.Lat := StrToFloatDef(ini.ReadString('MapView', 'Center.Latitude', ''), 0.0, PointFormatSettings); @@ -566,6 +581,11 @@ begin ini.WriteString('MapView', 'DistanceUnits', DistanceUnit_Names[DistanceUnit]); + if HERE_AppID <> '' then + ini.WriteString('HERE', 'APP_ID', HERE_AppID); + if HERE_AppCode <> '' then + ini.WriteString('HERE', 'APP_CODE', HERE_AppCode); + ini.EraseSection('Locations'); for i := 0 to CbLocations.Items.Count-1 do ini.WriteString('Locations', 'Item'+IntToStr(i), CbLocations.Items[i]); diff --git a/components/lazmapviewer/source/mvdlefpc.pas b/components/lazmapviewer/source/mvdlefpc.pas index 7f80d398d..4eb94c20c 100644 --- a/components/lazmapviewer/source/mvdlefpc.pas +++ b/components/lazmapviewer/source/mvdlefpc.pas @@ -25,6 +25,8 @@ unit mvDLEFpc; {$mode objfpc}{$H+} +{.$DEFINE LOG_URL} + interface uses @@ -60,7 +62,10 @@ type implementation uses - fphttpclient; + {$IFDEF LOG_URL} + lazlogger, + {$ENDIF} + fphttpclient, openssl; { TMVDEFPC } @@ -68,6 +73,10 @@ procedure TMVDEFPC.DownloadFile(const Url: string; AStream: TStream); var http: TFpHttpClient; begin + {$IFDEF LOG_URL} + DebugLn(Url); + {$ENDIF} + InitSSLInterface; http := TFpHttpClient.Create(nil); try {$IF FPC_FullVersion >= 30000} @@ -82,7 +91,10 @@ begin http.Proxy.Password := FProxyPassword; end; {$ENDIF} - http.Get(Url, AStream); + try + http.Get(Url, AStream); + except + end; AStream.Position := 0; finally http.Free; diff --git a/components/lazmapviewer/source/mvengine.pas b/components/lazmapviewer/source/mvengine.pas index 42f591117..5a4f52d30 100644 --- a/components/lazmapviewer/source/mvengine.pas +++ b/components/lazmapviewer/source/mvengine.pas @@ -106,7 +106,6 @@ Type function GetTileName(const Id: TTileId): String; procedure evDownload(Data: TObject; Job: TJob); procedure TileDownloaded(Data: PtrInt); - Procedure RegisterProviders; Procedure DrawTile(const TileId: TTileId; X,Y: integer; TileImg: TLazIntfImage); Procedure DoDrag(Sender: TDragObj); public @@ -124,6 +123,7 @@ Type function LonLatToWorldScreen(aPt: TRealPoint): TPoint; function ReadProvidersFromXML(AFileName: String; out AMsg: String): Boolean; procedure Redraw; + Procedure RegisterProviders; function ScreenToLonLat(aPt: TPoint): TRealPoint; procedure SetSize(aWidth, aHeight: integer); function WorldScreenToLonLat(aPt: TPoint): TRealPoint; @@ -174,6 +174,10 @@ function TryStrToGps(const AValue: String; out ADeg: Double): Boolean; procedure SplitGps(AValue: Double; out ADegs, AMins, ASecs: Double); +var + HERE_AppID: String = ''; + HERE_AppCode: String = ''; + implementation @@ -888,9 +892,46 @@ begin 'http://a%serv%.ortho.tiles.virtualearth.net/tiles/a%x%.jpg?g=72&shading=hill', 1, 19, 4, nil, @GetQuadKey); AddMapProvider('Virtual Earth Hybrid', - 'http://h%serv%.ortho.tiles.virtualearth.net/tiles/h%x%.jpg?g=72&shading=hill', + 'https://h%serv%.ortho.tiles.virtualearth.net/tiles/h%x%.jpg?g=72&shading=hill', 1, 19, 4, nil, @GetQuadKey); + if (HERE_AppID <> '') and (HERE_AppCode <> '') then begin + // Registration required to access HERE maps: + // https://developer.here.com/?create=Freemium-Basic&keepState=true&step=account + // Store the APP_ID and APP_CODE obtained after registration in the + // ini file of the demo under key [HERE] as items APP_ID and APP_CODE and + // restart the demo. + AddMapProvider('Here Maps', + 'https://%serv%.base.maps.api.here.com/maptile/2.1/maptile/newest/normal.day/%z%/%x%/%y%/256/png8' + + '?app_id=' + HERE_AppID + '&app_code=' + HERE_AppCode, + 1, 19, 4, nil); + AddMapProvider('Here Maps Grey', + 'https://%serv%.base.maps.api.here.com/maptile/2.1/maptile/newest/normal.day.grey/%z%/%x%/%y%/256/png8' + + '?app_id=' + HERE_AppID + '&app_code=' + HERE_AppCode, + 1, 19, 4, nil); + AddMapProvider('Here Maps Reduced', + 'https://%serv%.base.maps.api.here.com/maptile/2.1/maptile/newest/reduced.day/%z%/%x%/%y%/256/png8' + + '?app_id=' + HERE_AppID + '&app_code=' + HERE_AppCode, + 1, 19, 4, nil); + AddMapProvider('Here Maps Transit', + 'https://%serv%.base.maps.api.here.com/maptile/2.1/maptile/newest/normal.day.transit/%z%/%x%/%y%/256/png8' + + '?app_id=' + HERE_AppID + '&app_code=' + HERE_AppCode, + 1, 19, 4, nil); + AddMapProvider('Here POI Maps', + 'https://%serv%.base.maps.api.here.com/maptile/2.1/maptile/newest/normal.day/%z%/%x%/%y%/256/png8' + + '?app_id=' + HERE_AppID + '&app_code=' + HERE_AppCode + '&pois', + 1, 19, 4, nil); + AddMapProvider('Here Pedestrian Maps', + 'https://%serv%.base.maps.api.here.com/maptile/2.1/maptile/newest/pedestrian.day/%z%/%x%/%y%/256/png8'+ + '?app_id=' + HERE_AppID + '&app_code=' + HERE_AppCode, + 1, 19, 4, nil); +{ AddMapProvider('Here DreamWorks Maps', Format(url, ['normal.day']) + '&style=dreamworks', + 1, 19, 4, nil); + AddMapProvider('Here Pedestrian Maps', Format(url, ['pededrian.day']), + 1, 19, 4, nil); + } + end; + { The Ovi Maps (former Nokia maps) are no longer available. AddMapProvider('Ovi Normal',