lazmapviewer: Add HERE maps (registration required).

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6887 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-04-30 22:22:18 +00:00
parent 7ea250941e
commit 5c2ed7f07a
5 changed files with 91 additions and 11 deletions

View File

@ -26,13 +26,16 @@
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="2">
<RequiredPackages Count="3">
<Item1>
<PackageName Value="lazMapViewerPkg"/>
<PackageName Value="lazMapViewer_Synapse"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
<PackageName Value="lazMapViewerPkg"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="4">
<Unit0>

View File

@ -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

View File

@ -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]);

View File

@ -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}
try
http.Get(Url, AStream);
except
end;
AStream.Position := 0;
finally
http.Free;

View File

@ -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',