LazMapViewer: Support tile sizes other than 256x256 (experimental feature). Add OpenRailwayMap provider for 512x512 tiles.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9494 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2024-11-02 14:58:29 +00:00
parent eb6ddb92e4
commit 1f22d2634b
9 changed files with 232 additions and 148 deletions

View File

@ -43,6 +43,7 @@
<Unit0> <Unit0>
<Filename Value="mapviewer_demo.lpr"/> <Filename Value="mapviewer_demo.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="MapViewer_Demo"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
<Filename Value="main.pas"/> <Filename Value="main.pas"/>

View File

@ -12,8 +12,8 @@ uses
begin begin
RequireDerivedFormResource:=True; RequireDerivedFormResource:=True;
Application.Title:='MapViewer_Demo'; Application.Title := 'MapViewer_Demo';
Application.Scaled:=True; Application.Scaled := True;
Application.Initialize; Application.Initialize;
Application.CreateForm(TMainForm, MainForm); Application.CreateForm(TMainForm, MainForm);
Application.CreateForm(TGPSListViewer, GPSListViewer); Application.CreateForm(TGPSListViewer, GPSListViewer);

View File

@ -17,19 +17,22 @@ unit mvCache;
interface interface
uses uses
Classes, SysUtils, IntfGraphics, syncObjs, Classes, SysUtils, Types, FPImage, IntfGraphics, syncObjs,
mvMapProvider, mvTypes, FPImage; mvMapProvider, mvTypes;
Type Type
{ TPictureCacheItem } { TPictureCacheItem }
TPictureCacheItem = class(TObject) TPictureCacheItem = class(TObject)
private
FTileSize: TSize;
protected protected
function GetImageObject: TObject; virtual; function GetImageObject: TObject; virtual;
class function GetImageReader({%H-}AStream: TStream): TFPCustomImageReader; class function GetImageReader({%H-}AStream: TStream): TFPCustomImageReader;
public public
constructor Create({%H-}AStream: TStream); virtual; constructor Create({%H-}AStream: TStream); virtual;
destructor Destroy; override; destructor Destroy; override;
property TileSize: TSize read FTileSize write FTileSize;
end; end;
TPictureCacheItemClass = class of TPictureCacheItem; TPictureCacheItemClass = class of TPictureCacheItem;
@ -46,6 +49,7 @@ Type
FBasePath: String; FBasePath: String;
FUseDisk: Boolean; FUseDisk: Boolean;
FUseThreads: Boolean; FUseThreads: Boolean;
FTileSize: TSize;
procedure SetCacheItemClass(AValue: TPictureCacheItemClass); procedure SetCacheItemClass(AValue: TPictureCacheItemClass);
procedure SetUseThreads(AValue: Boolean); procedure SetUseThreads(AValue: Boolean);
Procedure EnterCrit; Procedure EnterCrit;
@ -71,6 +75,7 @@ Type
property UseThreads: Boolean read FUseThreads write SetUseThreads; property UseThreads: Boolean read FUseThreads write SetUseThreads;
property CacheItemClass: TPictureCacheItemClass read FCacheItemClass write SetCacheItemClass; property CacheItemClass: TPictureCacheItemClass read FCacheItemClass write SetCacheItemClass;
property MaxAge: Integer read FMaxAge write FMaxAge; // in days property MaxAge: Integer read FMaxAge write FMaxAge; // in days
property TileSize: TSize read FTileSize;
end; end;
@ -341,6 +346,7 @@ var
idx: integer; idx: integer;
begin begin
FileName := GetFileName(MapProvider, TileId); FileName := GetFileName(MapProvider, TileId);
FTileSize := MapProvider.TileSize;
EnterCrit; EnterCrit;
try try
idx := Cache.IndexOf(FileName); idx := Cache.IndexOf(FileName);
@ -352,6 +358,7 @@ begin
idx := 0; idx := 0;
end; end;
item:= FCacheItemClass.Create(Stream); //GetNewImgFor(Stream); item:= FCacheItemClass.Create(Stream); //GetNewImgFor(Stream);
item.TileSize := FTileSize;
Cache.Objects[idx]:=item; Cache.Objects[idx]:=item;
finally finally
LeaveCrit; LeaveCrit;
@ -439,7 +446,8 @@ begin
// e.g 0.5 = right or lower half of the tile, when divided by 2 // e.g 0.5 = right or lower half of the tile, when divided by 2
ltid := TileId; ltid := TileId;
lDeltaZoom := 1; lDeltaZoom := 1;
w := TILE_SIZE; FTileSize := MapProvider.TileSize;
w := tileSize.CX;
repeat repeat
w := w shr 1; w := w shr 1;
dec(ltid.Z); dec(ltid.Z);
@ -452,8 +460,8 @@ begin
begin // We found a tile in the cache that contains the preview begin // We found a tile in the cache that contains the preview
xfrac := xfrac - ltid.X; //xfrac and yfrac calculated for the position in the tile from the cache xfrac := xfrac - ltid.X; //xfrac and yfrac calculated for the position in the tile from the cache
yfrac := yfrac - ltid.Y; yfrac := yfrac - ltid.Y;
px := Trunc(xfrac * TILE_SIZE); //x and y are the percentage of the tile width px := Trunc(xfrac * FTileSize.CX); //x and y are the percentage of the tile width
py := Trunc(yfrac * TILE_SIZE); py := Trunc(yfrac * FTileSize.CY);
ARect := Rect(px, py, px+w, py+w); ARect := Rect(px, py, px+w, py+w);
TileID := ltid; TileID := ltid;
Result := true; Result := true;

View File

@ -195,7 +195,7 @@ begin
raise EInvalidGraphic.Create('PNG/JPG expected.'); raise EInvalidGraphic.Create('PNG/JPG expected.');
try try
rawImg.Init; rawImg.Init;
rawImg.Description.Init_BPP32_B8G8R8A8_BIO_TTB(TILE_SIZE, TILE_SIZE); rawImg.Description.Init_BPP32_B8G8R8A8_BIO_TTB(TileSize.CX, TileSize.CY);
FImage := TLazIntfImage.Create(rawImg, True); FImage := TLazIntfImage.Create(rawImg, True);
try try
FImage.LoadFromStream(AStream, Reader); FImage.LoadFromStream(AStream, Reader);

View File

@ -20,7 +20,7 @@ unit mvEngine;
interface interface
uses uses
Classes, SysUtils, IntfGraphics, Controls, Math, GraphType, FPImage, Classes, SysUtils, Types, IntfGraphics, Controls, Math, GraphType, FPImage,
mvTypes, mvGeoMath, mvJobQueue, mvMapProvider, mvDownloadEngine, mvCache, mvDragObj; mvTypes, mvGeoMath, mvJobQueue, mvMapProvider, mvDownloadEngine, mvCache, mvDragObj;
type type
@ -125,6 +125,7 @@ type
procedure AdjustZoomCenter(var AWin: TMapWindow); procedure AdjustZoomCenter(var AWin: TMapWindow);
procedure ConstraintZoom(var aWin: TMapWindow); procedure ConstraintZoom(var aWin: TMapWindow);
function GetTileName(const Id: TTileId): String; function GetTileName(const Id: TTileId): String;
function GetTileSize: TSize;
procedure evDownload(Data: TObject; Job: TJob); procedure evDownload(Data: TObject; Job: TJob);
procedure TileDownloaded(Data: PtrInt); procedure TileDownloaded(Data: PtrInt);
procedure EraseBackground(const R: TRect); procedure EraseBackground(const R: TRect);
@ -140,9 +141,9 @@ type
constructor Create(aOwner: TComponent); override; constructor Create(aOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
function AddMapProvider(OpeName: String; ProjectionType: TProjectionType; Url: String; function AddMapProvider(OpeName: String; ProjectionType: TProjectionType;
MinZoom, MaxZoom, NbSvr: integer; GetSvrStr: TGetSvrStr = nil; ATileSize: TSize; Url: String; MinZoom, MaxZoom, NbSvr: integer;
GetXStr: TGetValStr = nil; GetYStr: TGetValStr = nil; GetSvrStr: TGetSvrStr = nil; GetXStr: TGetValStr = nil; GetYStr: TGetValStr = nil;
GetZStr: TGetValStr = nil): TMapProvider; GetZStr: TGetValStr = nil): TMapProvider;
procedure CancelCurrentDrawing; procedure CancelCurrentDrawing;
procedure ClearMapProviders; procedure ClearMapProviders;
@ -187,6 +188,7 @@ type
property CacheMaxAge: Integer read GetCacheMaxAge write SetCacheMaxAge; property CacheMaxAge: Integer read GetCacheMaxAge write SetCacheMaxAge;
property ZoomMin: Integer read FZoomMax write FZoomMin; property ZoomMin: Integer read FZoomMax write FZoomMin;
property ZoomMax: Integer read FZoomMax write FZoomMax; property ZoomMax: Integer read FZoomMax write FZoomMax;
property TileSize: TSize read GetTileSize;
published published
property Active: Boolean read FActive write SetActive default false; property Active: Boolean read FActive write SetActive default false;
@ -319,7 +321,7 @@ begin
end; end;
function TMapViewerEngine.AddMapProvider(OpeName: String; ProjectionType: TProjectionType; function TMapViewerEngine.AddMapProvider(OpeName: String; ProjectionType: TProjectionType;
Url: String; MinZoom, MaxZoom, NbSvr: integer; GetSvrStr: TGetSvrStr; ATileSize: TSize; Url: String; MinZoom, MaxZoom, NbSvr: integer; GetSvrStr: TGetSvrStr;
GetXStr: TGetValStr; GetYStr: TGetValStr; GetZStr: TGetValStr): TMapProvider; GetXStr: TGetValStr; GetYStr: TGetValStr; GetZStr: TGetValStr): TMapProvider;
var var
idx :integer; idx :integer;
@ -332,7 +334,7 @@ Begin
end end
else else
Result := TMapProvider(lstProvider.Objects[idx]); Result := TMapProvider(lstProvider.Objects[idx]);
Result.AddUrl(Url, ProjectionType, NbSvr, MinZoom, MaxZoom, GetSvrStr, GetXStr, GetYStr, GetZStr); Result.AddUrl(Url, ProjectionType, ATileSize, NbSvr, MinZoom, MaxZoom, GetSvrStr, GetXStr, GetYStr, GetZStr);
end; end;
procedure TMapViewerEngine.AdjustZoomCenter(var AWin: TMapWindow); procedure TMapViewerEngine.AdjustZoomCenter(var AWin: TMapWindow);
@ -352,20 +354,22 @@ function TMapViewerEngine.CalculateVisibleTiles(const aWin: TMapWindow; out
var var
MaxX, MaxY, startX, startY: int64; MaxX, MaxY, startX, startY: int64;
WorldMax: Int64; WorldMax: Int64;
tileSz: TSize;
begin begin
Area := Default(TArea); Area := Default(TArea);
Result := (aWin.X <= 0) and (aWin.Y <= 0); Result := (aWin.X <= 0) and (aWin.Y <= 0);
WorldMax := Int64(1) shl AWin.Zoom - 1; WorldMax := Int64(1) shl AWin.Zoom - 1;
MaxX := Int64(aWin.Width) div TILE_SIZE + 1; tileSz := TileSize;
MaxY := Int64(aWin.Height) div TILE_SIZE + 1; MaxX := Int64(aWin.Width) div tileSz.CX + 1;
MaxY := Int64(aWin.Height) div tileSz.CY + 1;
if (MaxX > WorldMax) or (MaxY > WorldMax) then if (MaxX > WorldMax) or (MaxY > WorldMax) then
begin begin
Result := False; Result := False;
MaxX := Min(WorldMax, MaxX); MaxX := Min(WorldMax, MaxX);
MaxY := Min(WorldMax, MaxY); MaxY := Min(WorldMax, MaxY);
end; end;
startX := -aWin.X div TILE_SIZE; startX := -aWin.X div tileSz.CX;
startY := -aWin.Y div TILE_SIZE; startY := -aWin.Y div tileSz.CY;
if (startX < 0) or (startY < 0) then if (startX < 0) or (startY < 0) then
begin begin
startX := Max(0, startX); startX := Max(0, startX);
@ -437,7 +441,7 @@ begin
exit(false); exit(false);
// Catch the case, that the screen is wider than the whole world // Catch the case, that the screen is wider than the whole world
mapWidth := mvGeoMath.ZoomFactor(MapWin.Zoom) * TILE_SIZE; mapWidth := mvGeoMath.ZoomFactor(MapWin.Zoom) * TileSize.CX;
Result := (MapWin.Width > mapWidth); Result := (MapWin.Width > mapWidth);
if not Result then if not Result then
begin begin
@ -619,6 +623,14 @@ begin
Result := IntToStr(Id.X) + '.' + IntToStr(Id.Y) + '.' + IntToStr(Id.Z); Result := IntToStr(Id.X) + '.' + IntToStr(Id.Y) + '.' + IntToStr(Id.Z);
end; end;
function TMapViewerEngine.GetTileSize: TSize;
begin
if Assigned(MapWin.MapProvider) then
Result := MapWin.MapProvider.TileSize
else
Result := TILE_SIZE_256;
end;
function TMapViewerEngine.GetUseThreads: Boolean; function TMapViewerEngine.GetUseThreads: Boolean;
begin begin
Result := Queue.UseThreads; Result := Queue.UseThreads;
@ -669,7 +681,7 @@ begin
Result.X := pixelLocation.x + AWin.X; Result.X := pixelLocation.x + AWin.X;
if FCyclic and CrossesDateline then if FCyclic and CrossesDateline then
begin begin
mapWidth := ZoomFactor(AWin.Zoom) * TILE_SIZE; mapWidth := ZoomFactor(AWin.Zoom) * TileSize.CX;
while (Result.X < 0) do while (Result.X < 0) do
Result.X := Result.X + mapWidth; Result.X := Result.X + mapWidth;
while (Result.X > AWin.Width) do while (Result.X > AWin.Width) do
@ -688,8 +700,9 @@ const
MAX_LONGITUDE = 180; MAX_LONGITUDE = 180;
TWO_PI = 2.0 * pi; TWO_PI = 2.0 * pi;
var var
factor, px, py: Extended; factorX, factorY, px, py: Extended;
pt: TRealPoint; pt: TRealPoint;
tileSz: TSize;
begin begin
// https://epsg.io/3857 // https://epsg.io/3857
// https://pubs.usgs.gov/pp/1395/report.pdf, page 41 // https://pubs.usgs.gov/pp/1395/report.pdf, page 41
@ -697,9 +710,11 @@ begin
pt.Lat := Math.EnsureRange(APt.Lat, MIN_LATITUDE, MAX_LATITUDE); pt.Lat := Math.EnsureRange(APt.Lat, MIN_LATITUDE, MAX_LATITUDE);
pt.Lon := Math.EnsureRange(APt.Lon, MIN_LONGITUDE, MAX_LONGITUDE); pt.Lon := Math.EnsureRange(APt.Lon, MIN_LONGITUDE, MAX_LONGITUDE);
factor := TILE_SIZE / TWO_PI * ZoomFactor(AWin.Zoom); tileSz := TileSize;
px := factor * (pt.LonRad + pi); factorX := tileSz.CX / TWO_PI * ZoomFactor(AWin.Zoom);
py := factor * (pi - ln( tan(pi/4 + pt.LatRad/2) )); factorY := tileSz.CY / TWO_PI * ZoomFactor(AWin.Zoom);
px := factorX * (pt.LonRad + pi);
py := factorY * (pi - ln( tan(pi/4 + pt.LatRad/2) ));
Result.x := Round(px); Result.x := Round(px);
Result.y := Round(py); Result.y := Round(py);
@ -768,7 +783,7 @@ var
mPoint : TPoint; mPoint : TPoint;
PType: TProjectionType; PType: TProjectionType;
begin begin
mapWidth := round(mvGeoMath.ZoomFactor(AWin.Zoom)) * TILE_SIZE; mapWidth := round(mvGeoMath.ZoomFactor(AWin.Zoom)) * TileSize.CX;
if FCyclic then if FCyclic then
begin begin
@ -797,6 +812,7 @@ const
MAX_LONGITUDE = 180; MAX_LONGITUDE = 180;
var var
zoomfac: Int64; zoomfac: Int64;
tileSz: TSize;
begin begin
// https://epsg.io/3857 // https://epsg.io/3857
// https://pubs.usgs.gov/pp/1395/report.pdf, page 41 // https://pubs.usgs.gov/pp/1395/report.pdf, page 41
@ -805,8 +821,9 @@ begin
// Result.LonRad := ( APoints.X / (( TILE_SIZE / (2*pi)) * 2**Zoom) ) - pi; // Result.LonRad := ( APoints.X / (( TILE_SIZE / (2*pi)) * 2**Zoom) ) - pi;
// Result.LatRad := arctan( sinh(pi - (APoints.Y/TILE_SIZE) / 2**Zoom * pi*2) ); // Result.LatRad := arctan( sinh(pi - (APoints.Y/TILE_SIZE) / 2**Zoom * pi*2) );
zoomFac := mvGeoMath.ZoomFactor(Zoom); zoomFac := mvGeoMath.ZoomFactor(Zoom);
Result.LonRad := ( APoint.X / (( TILE_SIZE / (2*pi)) * zoomFac) ) - pi; tileSz := TileSize;
Result.LatRad := arctan( sinh(pi - (APoint.Y/TILE_SIZE) / zoomFac * pi*2) ); Result.LonRad := ( APoint.X / (( tileSz.CX / (2*pi)) * zoomFac) ) - pi;
Result.LatRad := arctan( sinh(pi - (APoint.Y/tileSz.CY) / zoomFac * pi*2) );
Result.Lat := Math.EnsureRange(Result.Lat, MIN_LATITUDE, MAX_LATITUDE); Result.Lat := Math.EnsureRange(Result.Lat, MIN_LATITUDE, MAX_LATITUDE);
Result.Lon := Math.EnsureRange(Result.Lon, MIN_LONGITUDE, MAX_LONGITUDE); Result.Lon := Math.EnsureRange(Result.Lon, MIN_LONGITUDE, MAX_LONGITUDE);
@ -977,6 +994,22 @@ function TMapViewerEngine.ReadProvidersFromXML(AFileName: String;
end; end;
end; end;
function CalcTileSize(s: String): TSize;
var
x: Integer;
w, h: Integer;
begin
Result := TILE_SIZE_256;
if s <> '' then
begin
x := pos('x', s);
if TryStrToInt(Trim(copy(s, 1, x-1)), w) and TryStrToInt(Trim(copy(s, x+1, Length(s))), h) then
Result := Size(w, h)
else
raise Exception.CreateFmt('Invalid tile size value %s', [s]);
end;
end;
var var
stream: TFileStream; stream: TFileStream;
doc: TXMLDocument = nil; doc: TXMLDocument = nil;
@ -993,6 +1026,7 @@ var
yProc: String; yProc: String;
zProc: String; zProc: String;
first: Boolean; first: Boolean;
tileSz: TSize;
begin begin
Result := false; Result := false;
AMsg := ''; AMsg := '';
@ -1025,6 +1059,7 @@ begin
else svrCount := StrToInt(s); else svrCount := StrToInt(s);
s := Concat('pt', GetAttrValue(layerNode, 'projection')); s := Concat('pt', GetAttrValue(layerNode, 'projection'));
projectionType := TProjectionType(GetEnumValue(TypeInfo(TProjectionType), s)); //-1 will default to ptEPSG3857 projectionType := TProjectionType(GetEnumValue(TypeInfo(TProjectionType), s)); //-1 will default to ptEPSG3857
tileSz := CalcTileSize(GetAttrValue(layerNode, 'tileSize'));
svrProc := GetAttrValue(layerNode, 'serverProc'); svrProc := GetAttrValue(layerNode, 'serverProc');
xProc := GetAttrValue(layerNode, 'xProc'); xProc := GetAttrValue(layerNode, 'xProc');
yProc := GetAttrValue(layerNode, 'yProc'); yProc := GetAttrValue(layerNode, 'yProc');
@ -1035,7 +1070,7 @@ begin
ClearMapProviders; ClearMapProviders;
first := false; first := false;
end; end;
AddMapProvider(providerName, projectionType, AddMapProvider(providerName, projectionType, tileSz,
url, minZoom, maxZoom, svrCount, url, minZoom, maxZoom, svrCount,
GetSvrStr(svrProc), GetValStr(xProc), GetValStr(yProc), GetValStr(zProc) GetSvrStr(svrProc), GetValStr(xProc), GetValStr(yProc), GetValStr(zProc)
); );
@ -1064,6 +1099,7 @@ var
previewDrawn: Boolean; previewDrawn: Boolean;
previewImg: TPictureCacheItem; previewImg: TPictureCacheItem;
R: TRect; R: TRect;
tileSz: TSize;
procedure AddJob; procedure AddJob;
var var
@ -1084,22 +1120,22 @@ var
var var
T, L, B, R: Integer; T, L, B, R: Integer;
begin begin
T := -AWin.Y div TILE_SIZE - Max(0, Sign(AWin.Y)); T := -AWin.Y div tileSz.CY - Max(0, Sign(AWin.Y));
B := T + AWin.Height div TILE_SIZE + 1; B := T + AWin.Height div tileSz.CY + 1;
L := -AWin.X div TILE_SIZE - Max(0, Sign(AWin.X)); L := -AWin.X div tileSz.CX - Max(0, Sign(AWin.X));
R := L + AWin.Width div TILE_SIZE + 1; R := L + AWin.Width div tileSz.CX + 1;
if T < TilesVis.top then // Erase above top if T < TilesVis.top then // Erase above top
EraseBackground(Rect(0, 0, AWin.Width, AWin.Y + TilesVis.top * TILE_SIZE)); EraseBackground(Rect(0, 0, AWin.Width, AWin.Y + TilesVis.top * tileSz.CY));
if L < TilesVis.left then // Erase on the left if L < TilesVis.left then // Erase on the left
EraseBackground(Rect(0, AWin.Y + TilesVis.top * TILE_SIZE, EraseBackground(Rect(0, AWin.Y + TilesVis.top * tileSz.CY,
AWin.X + TilesVis.left * TILE_SIZE, AWin.X + TilesVis.left * tileSz.CX,
AWin.Y + (TilesVis.bottom + 1) * TILE_SIZE)); AWin.Y + (TilesVis.bottom + 1) * tileSz.CY));
if R > TilesVis.right then // Erase on the right if R > TilesVis.right then // Erase on the right
EraseBackground(Rect(AWin.X + (TilesVis.right + 1) * TILE_SIZE, EraseBackground(Rect(AWin.X + (TilesVis.right + 1) * tileSz.CX,
AWin.Y + TilesVis.top * TILE_SIZE, AWin.Width, AWin.Y + TilesVis.top * tileSz.CY, AWin.Width,
AWin.Y + (TilesVis.bottom + 1) * TILE_SIZE)); AWin.Y + (TilesVis.bottom + 1) * tileSz.CY));
if B > TilesVis.bottom then // Erase below if B > TilesVis.bottom then // Erase below
EraseBackground(Rect(0, AWin.Y + (TilesVis.bottom + 1) * TILE_SIZE, EraseBackground(Rect(0, AWin.Y + (TilesVis.bottom + 1) * tileSz.CY,
AWin.Width, AWin.Height)); AWin.Width, AWin.Height));
end; end;
@ -1112,12 +1148,14 @@ begin
Exit; Exit;
end; end;
tileSz := TileSize;
if not CalculateVisibleTiles(AWin, TilesVis) then if not CalculateVisibleTiles(AWin, TilesVis) then
EraseAround; EraseAround;
SetLength(Tiles, (TilesVis.Bottom - TilesVis.Top + 1) * (TilesVis.Right - TilesVis.Left + 1)); SetLength(Tiles, (TilesVis.Bottom - TilesVis.Top + 1) * (TilesVis.Right - TilesVis.Left + 1));
iTile := Low(Tiles); iTile := Low(Tiles);
numTiles := 1 shl AWin.Zoom; numTiles := 1 shl AWin.Zoom;
XShift := IfThen(aWin.X > 0, numTiles - aWin.X div TILE_SIZE - 1, 0); XShift := IfThen(aWin.X > 0, numTiles - aWin.X div tileSz.CX - 1, 0);
for y := TilesVis.Top to TilesVis.Bottom do for y := TilesVis.Top to TilesVis.Bottom do
for X := TilesVis.Left to TilesVis.Right do for X := TilesVis.Left to TilesVis.Right do
begin begin
@ -1139,8 +1177,8 @@ begin
// is not valid // is not valid
begin begin
previewdrawn := False; previewdrawn := False;
py := AWin.Y + Y * TILE_SIZE; py := AWin.Y + Y * tileSz.CY;
px := AWin.X + X * TILE_SIZE; px := AWin.X + X * tileSz.CX;
if FDrawPreviewTiles then if FDrawPreviewTiles then
begin begin
if IsValidTile(AWin, Tiles[iTile]) then // Invalid tiles probably will not be found in the cache if IsValidTile(AWin, Tiles[iTile]) then // Invalid tiles probably will not be found in the cache
@ -1372,33 +1410,35 @@ var
worldWidth : Integer; worldWidth : Integer;
numTiles : Integer; numTiles : Integer;
baseX : Integer; baseX : Integer;
tileSz: TSize;
begin begin
if IsCurrentWin(AWin)then if IsCurrentWin(AWin)then
begin begin
Cache.GetFromCache(AWin.MapProvider, ATile, img); Cache.GetFromCache(AWin.MapProvider, ATile, img);
Y := AWin.Y + ATile.Y * TILE_SIZE; // begin of Y tileSz := TileSize;
Y := AWin.Y + ATile.Y * tileSz.CY; // begin of Y
if Cyclic then if Cyclic then
begin begin
baseX := AWin.X + ATile.X * TILE_SIZE; // begin of X baseX := AWin.X + ATile.X * tileSz.CX; // begin of X
numTiles := 1 shl AWin.Zoom; numTiles := 1 shl AWin.Zoom;
worldWidth := numTiles * TILE_SIZE; worldWidth := numTiles * tileSz.CX;
// From the center to the left (western) hemisphere // From the center to the left (western) hemisphere
X := baseX; X := baseX;
while (X+TILE_SIZE >= 0) do while (X+tileSz.CX >= 0) do
begin begin
DrawTile(ATile, X, Y, img); DrawTile(ATile, X, Y, img);
X := X - worldWidth; X := X - worldWidth;
end; end;
// From the center to the right (eastern) hemisphere // From the center to the right (eastern) hemisphere
X := baseX + worldWidth; X := baseX + worldWidth;
while ((X-TILE_SIZE) <= AWin.Width) do while ((X-tileSz.CX) <= AWin.Width) do
begin begin
DrawTile(ATile, X, Y, img); DrawTile(ATile, X, Y, img);
X := X + worldWidth; X := X + worldWidth;
end; end;
end else end else
begin begin
X := AWin.X + ATile.X * TILE_SIZE; // begin of X X := AWin.X + ATile.X * tileSz.CX; // begin of X
DrawTile(ATile, X, Y, img); DrawTile(ATile, X, Y, img);
end; end;
end; end;

View File

@ -8,6 +8,7 @@
- https://vec01.maps.yandex.net/tiles?l=map&x=51693+570&y=32520&z=16&scale=1&lang=ru_RU - https://vec01.maps.yandex.net/tiles?l=map&x=51693+570&y=32520&z=16&scale=1&lang=ru_RU
- https://www.linux.org.ru/forum/development/9038716 - https://www.linux.org.ru/forum/development/9038716
- https://wiki.openstreetmap.org/wiki/Tiles - https://wiki.openstreetmap.org/wiki/Tiles
- (https://wiki.openstreetmap.org/wiki/OpenRailwayMap/API)
- https://pubs.usgs.gov/pp/1395/report.pdf - https://pubs.usgs.gov/pp/1395/report.pdf
- https://wiki.openstreetmap.org/wiki/Slippy_map_tilenames#Tile_numbers_to_lon..2Flat. - https://wiki.openstreetmap.org/wiki/Slippy_map_tilenames#Tile_numbers_to_lon..2Flat.
- https://mc.bbbike.org/mc/?num=2 - https://mc.bbbike.org/mc/?num=2
@ -22,15 +23,18 @@ Some providers submitted by
} }
// OpenStreetMap section // OpenStreetMap section
MapWin.MapProvider := AddMapProvider('OpenStreetMap Mapnik', ptEPSG3857, 'http://%serv%.tile.openstreetmap.org/%z%/%x%/%y%.png', 0, 19, 3, @GetSvrLetter); MapWin.MapProvider := AddMapProvider('OpenStreetMap Mapnik', ptEPSG3857, TILE_SIZE_256, 'http://%serv%.tile.openstreetmap.org/%z%/%x%/%y%.png', 0, 19, 3, @GetSvrLetter);
// OSM Wikipedia no longer available for services outside Wikimedia projects. // OSM Wikipedia no longer available for services outside Wikimedia projects.
// AddMapProvider('OpenStreetMap Wikipedia', ptEPSG3857, 'https://maps.wikimedia.org/osm-intl/%z%/%x%/%y%.png', 0, 19, 3, @GetSvrLetter); // AddMapProvider('OpenStreetMap Wikipedia', ptEPSG3857, 'https://maps.wikimedia.org/osm-intl/%z%/%x%/%y%.png', 0, 19, 3, @GetSvrLetter);
// OSM Sputnik is no longer available. Keeping it here for reference only... // OSM Sputnik is no longer available. Keeping it here for reference only...
// AddMapProvider('OpenStreetMap Sputnik', ptEPSG3857, 'https://%serv%.tilessputnik.ru/tiles/kmt2/%z%/%x%/%y%.png', 0, 19, 3, @GetSvrLetter); // AddMapProvider('OpenStreetMap Sputnik', ptEPSG3857, 'https://%serv%.tilessputnik.ru/tiles/kmt2/%z%/%x%/%y%.png', 0, 19, 3, @GetSvrLetter);
AddMapProvider('OpenStreetMap.fr Hot', ptEPSG3857, 'https://%serv%.tile.openstreetmap.fr/hot/%z%/%x%/%y%.png', 0, 18, 3, @GetSvrLetter); AddMapProvider('OpenStreetMap.fr Hot', ptEPSG3857, TILE_SIZE_256, 'https://%serv%.tile.openstreetmap.fr/hot/%z%/%x%/%y%.png', 0, 18, 3, @GetSvrLetter);
AddMapProvider('Open Topo Map', ptEPSG3857, 'http://%serv%.tile.opentopomap.org/%z%/%x%/%y%.png', 0, 19, 3, @GetSvrLetter); AddMapProvider('Open Topo Map', ptEPSG3857, TILE_SIZE_256, 'http://%serv%.tile.opentopomap.org/%z%/%x%/%y%.png', 0, 19, 3, @GetSvrLetter);
AddMapProvider('OpenStreetMap.fr Cycle Map', ptEPSG3857, 'https://dev.%serv%.tile.openstreetmap.fr/cyclosm/%z%/%x%/%y%.png', 0, 18, 3, @GetSvrLetter); AddMapProvider('OpenStreetMap.fr Cycle Map', ptEPSG3857, TILE_SIZE_256, 'https://dev.%serv%.tile.openstreetmap.fr/cyclosm/%z%/%x%/%y%.png', 0, 18, 3, @GetSvrLetter);
AddMapProvider('OSM Refuges', ptEPSG3857, 'https://maps.refuges.info/hiking/%z%/%x%/%y%.png', 0, 19, 4, nil); AddMapProvider('OSM Refuges', ptEPSG3857, TILE_SIZE_256, 'https://maps.refuges.info/hiking/%z%/%x%/%y%.png', 0, 19, 4, nil);
AddMapProvider('OpenRailwayMap Standard', ptEPSG3857, TILE_SIZE_512, 'https://%serv%.tiles.openrailwaymap.org/standard/%z%/%x%/%y%.png', 0, 18, 3, @GetSvrLetter); // Creative-Commons license Attribution-ShareAlike 2.0 (CC-BY-SA 2.0) (https://wiki.openstreetmap.org/wiki/OpenRailwayMap/API)
AddMapProvider('OpenRailwayMap Signals', ptEPSG3857, TILE_SIZE_512, 'https://%serv%.tiles.openrailwaymap.org/signals/%z%/%x%/%y%.png', 0, 18, 3, @GetSvrLetter); // Creative-Commons license Attribution-ShareAlike 2.0 (CC-BY-SA 2.0) (https://wiki.openstreetmap.org/wiki/OpenRailwayMap/API)
AddMapProvider('OpenRailwayMap MaxSpeed', ptEPSG3857, TILE_SIZE_512, 'https://%serv%.tiles.openrailwaymap.org/maxspeed/%z%/%x%/%y%.png', 0, 18, 3, @GetSvrLetter); // Creative-Commons license Attribution-ShareAlike 2.0 (CC-BY-SA 2.0) (https://wiki.openstreetmap.org/wiki/OpenRailwayMap/API)
// API Key required // API Key required
if (ThunderForest_ApiKey <> '') then if (ThunderForest_ApiKey <> '') then
@ -39,48 +43,48 @@ Some providers submitted by
// https://www.thunderforest.com/docs/apikeys/ // https://www.thunderforest.com/docs/apikeys/
// The API key is found on their website after registration and logging in. // The API key is found on their website after registration and logging in.
// Store the API key in the ini file under key [ThunderForest] as item API_Key // Store the API key in the ini file under key [ThunderForest] as item API_Key
AddMapProvider('ThunderForest Open Cycle Map', ptEPSG3857, 'https://tile.thunderforest.com/cycle/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 3, nil, nil, nil, nil); AddMapProvider('ThunderForest Open Cycle Map', ptEPSG3857, TILE_SIZE_256, 'https://tile.thunderforest.com/cycle/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 3, nil, nil, nil, nil);
AddMapProvider('ThunderForest OpenStreetMap Transport', ptEPSG3857, 'https://tile.thunderforest.com/transport/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 3, nil, nil, nil, nil); AddMapProvider('ThunderForest OpenStreetMap Transport', ptEPSG3857, TILE_SIZE_256, 'https://tile.thunderforest.com/transport/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 3, nil, nil, nil, nil);
AddMapProvider('ThunderForest Neighbourhood', ptEPSG3857, 'https://tile.thunderforest.com/neighbourhood/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 4, nil); AddMapProvider('ThunderForest Neighbourhood', ptEPSG3857, TILE_SIZE_256, 'https://tile.thunderforest.com/neighbourhood/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 4, nil);
AddMapProvider('ThunderForest Atlas', ptEPSG3857, 'https://tile.thunderforest.com/atlas/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 4, nil); AddMapProvider('ThunderForest Atlas', ptEPSG3857, TILE_SIZE_256, 'https://tile.thunderforest.com/atlas/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 4, nil);
AddMapProvider('ThunderForest Pioneer', ptEPSG3857, 'https://tile.thunderforest.com/pioneer/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 4, nil); AddMapProvider('ThunderForest Pioneer', ptEPSG3857, TILE_SIZE_256, 'https://tile.thunderforest.com/pioneer/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 4, nil);
AddMapProvider('ThunderForest Outdoors', ptEPSG3857, 'https://tile.thunderforest.com/outdoors/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 4, nil); AddMapProvider('ThunderForest Outdoors', ptEPSG3857, TILE_SIZE_256, 'https://tile.thunderforest.com/outdoors/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 4, nil);
AddMapProvider('ThunderForest Landscape', ptEPSG3857, 'https://tile.thunderforest.com/outdoors/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 4, nil); AddMapProvider('ThunderForest Landscape', ptEPSG3857, TILE_SIZE_256, 'https://tile.thunderforest.com/outdoors/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 4, nil);
AddMapProvider('ThunderForest Mobile-Atlas', ptEPSG3857, 'https://tile.thunderforest.com/mobile-atlas/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 4, nil); AddMapProvider('ThunderForest Mobile-Atlas', ptEPSG3857, TILE_SIZE_256, 'https://tile.thunderforest.com/mobile-atlas/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 4, nil);
AddMapProvider('ThunderForest Transport-Dark', ptEPSG3857, 'https://tile.thunderforest.com/transport-dark/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 4, nil); AddMapProvider('ThunderForest Transport-Dark', ptEPSG3857, TILE_SIZE_256, 'https://tile.thunderforest.com/transport-dark/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 4, nil);
AddMapProvider('ThunderForest Spinal-Map', ptEPSG3857, 'https://tile.thunderforest.com/spinal-map/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 4, nil); AddMapProvider('ThunderForest Spinal-Map', ptEPSG3857, TILE_SIZE_256, 'https://tile.thunderforest.com/spinal-map/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 4, nil);
// The following providers could be used alternatively. No API key required, // The following providers could be used alternatively. No API key required,
// but has a gray "API Key required" watermark and maybe other restrictions! // but has a gray "API Key required" watermark and maybe other restrictions!
// AddMapProvider('Open Cycle Map', ptEPSG3857, 'http://%serv%.tile.opencyclemap.org/cycle/%z%/%x%/%y%.png', 0, 18, 3, @GetSvrLetter); // AddMapProvider('Open Cycle Map', ptEPSG3857, TILE_SIZE_256, 'http://%serv%.tile.opencyclemap.org/cycle/%z%/%x%/%y%.png', 0, 18, 3, @GetSvrLetter);
// AddMapProvider('OpenStreetMap Transport', ptEPSG3857, 'https://%serv%.tile.thunderforest.com/transport/%z%/%x%/%y%.png', 0, 18, 3, @GetSvrLetter); // AddMapProvider('OpenStreetMap Transport', ptEPSG3857, TILE_SIZE_256, 'https://%serv%.tile.thunderforest.com/transport/%z%/%x%/%y%.png', 0, 18, 3, @GetSvrLetter);
end; end;
// Google // Google
AddMapProvider('Google Maps', ptEPSG3857, 'http://mt%serv%.google.com/vt/lyrs=m@145&v=w2.104&x=%x%&y=%y%&z=%z%', 0, 19, 4, nil); AddMapProvider('Google Maps', ptEPSG3857, TILE_SIZE_256, 'http://mt%serv%.google.com/vt/lyrs=m@145&v=w2.104&x=%x%&y=%y%&z=%z%', 0, 19, 4, nil);
AddMapProvider('Google Satellite', ptEPSG3857, 'http://mt%serv%.google.com/vt/lyrs=y&hl=en&x=%x%&y=%y%&z=%z%' , 0, 19, 4, nil); AddMapProvider('Google Satellite', ptEPSG3857, TILE_SIZE_256, 'http://mt%serv%.google.com/vt/lyrs=y&hl=en&x=%x%&y=%y%&z=%z%' , 0, 19, 4, nil);
// not working any more (June 2023), replaced by above: // not working any more (June 2023), replaced by above:
//AddMapProvider('Google Satellite', ptEPSG3857, 'http://khm%serv%.google.com/kh/v=863?x=%x%&y=%y%&z=%z%', 0, 19, 4, nil); //AddMapProvider('Google Satellite', ptEPSG3857, TILE_SIZE_256, 'http://khm%serv%.google.com/kh/v=863?x=%x%&y=%y%&z=%z%', 0, 19, 4, nil);
AddMapProvider('Google Terrain', ptEPSG3857, 'http://mt%serv%.google.com/vt/lyrs=p&hl=en&x=%x%&y=%y%&z=%z%' , 0, 19, 4, nil); AddMapProvider('Google Terrain', ptEPSG3857, TILE_SIZE_256, 'http://mt%serv%.google.com/vt/lyrs=p&hl=en&x=%x%&y=%y%&z=%z%' , 0, 19, 4, nil);
AddMapProvider('Google Satellite Only', ptEPSG3857, 'http://mt%serv%.google.com/vt/lyrs=s&hl=en&x=%x%&y=%y%&z=%z%' , 0, 19, 4, nil); AddMapProvider('Google Satellite Only', ptEPSG3857, TILE_SIZE_256, 'http://mt%serv%.google.com/vt/lyrs=s&hl=en&x=%x%&y=%y%&z=%z%' , 0, 19, 4, nil);
AddMapProvider('Google Altered Roadmap', ptEPSG3857, 'http://mt%serv%.google.com/vt/lyrs=r&hl=en&x=%x%&y=%y%&z=%z%' , 0, 19, 4, nil); AddMapProvider('Google Altered Roadmap', ptEPSG3857, TILE_SIZE_256, 'http://mt%serv%.google.com/vt/lyrs=r&hl=en&x=%x%&y=%y%&z=%z%' , 0, 19, 4, nil);
AddMapProvider('Google Roadmap', ptEPSG3857, 'http://mt%serv%.google.com/vt/lyrs=m&hl=en&x=%x%&y=%y%&z=%z%' , 0, 19, 4, nil); AddMapProvider('Google Roadmap', ptEPSG3857, TILE_SIZE_256, 'http://mt%serv%.google.com/vt/lyrs=m&hl=en&x=%x%&y=%y%&z=%z%' , 0, 19, 4, nil);
// Yandex // Yandex
AddMapProvider('Yandex.Maps', ptEPSG3395, 'https://core-renderer-tiles.maps.yandex.net/tiles?l=map&x=%x%&y=%y%&z=%z%&scale=1', 0, 19, 4, nil, nil, nil, nil); // Russion labels AddMapProvider('Yandex.Maps', ptEPSG3395, TILE_SIZE_256, 'https://core-renderer-tiles.maps.yandex.net/tiles?l=map&x=%x%&y=%y%&z=%z%&scale=1', 0, 19, 4, nil, nil, nil, nil); // Russion labels
AddMapProvider('Yandex.Maps Satellite', ptEPSG3395, 'https://core-sat.maps.yandex.net/tiles?l=sat&x=%x%&y=%y%&z=%z%', 0, 19, 4, nil, nil, nil, nil); AddMapProvider('Yandex.Maps Satellite', ptEPSG3395, TILE_SIZE_256, 'https://core-sat.maps.yandex.net/tiles?l=sat&x=%x%&y=%y%&z=%z%', 0, 19, 4, nil, nil, nil, nil);
AddMapProvider('Yandex.Maps Satellite-old', ptEPSG3395, 'https://sat0%serv%.maps.yandex.net/tiles?l=sat&x=%x%&y=%y%&z=%z%', 0, 19, 4, @GetSvrBase1, nil, nil, nil); AddMapProvider('Yandex.Maps Satellite-old', ptEPSG3395, TILE_SIZE_256, 'https://sat0%serv%.maps.yandex.net/tiles?l=sat&x=%x%&y=%y%&z=%z%', 0, 19, 4, @GetSvrBase1, nil, nil, nil);
// The next ones are no longer valid. Keeping them here just in case ... // The next ones are no longer valid. Keeping them here just in case ...
//AddMapProvider('Yandex.Maps-old', ptEPSG3395, 'https://vec0%serv%.maps.yandex.net/tiles?l=map&x=%x%&y=%y%&z=%z%&scale=1&lang=ru_RU', 0, 19, 4, @GetSvrBase1, nil, nil, nil); //AddMapProvider('Yandex.Maps-old', ptEPSG3395, TILE_SIZE_256, 'https://vec0%serv%.maps.yandex.net/tiles?l=map&x=%x%&y=%y%&z=%z%&scale=1&lang=ru_RU', 0, 19, 4, @GetSvrBase1, nil, nil, nil);
// Bing // Bing
AddMapProvider('Virtual Earth Bing', ptEPSG3857, 'http://ecn.t%serv%.tiles.virtualearth.net/tiles/r%x%?g=671&mkt=en-us&lbl=l1&stl=h&shading=hill', 1, 19, 8, nil, @GetStrQuadKey); AddMapProvider('Virtual Earth Bing', ptEPSG3857, TILE_SIZE_256, 'http://ecn.t%serv%.tiles.virtualearth.net/tiles/r%x%?g=671&mkt=en-us&lbl=l1&stl=h&shading=hill', 1, 19, 8, nil, @GetStrQuadKey);
AddMapProvider('Virtual Earth Aerial', ptEPSG3857, 'http://a%serv%.ortho.tiles.virtualearth.net/tiles/a%x%.jpg?g=72&shading=hill', 1, 19, 4, nil, @GetStrQuadKey); AddMapProvider('Virtual Earth Aerial', ptEPSG3857, TILE_SIZE_256, 'http://a%serv%.ortho.tiles.virtualearth.net/tiles/a%x%.jpg?g=72&shading=hill', 1, 19, 4, nil, @GetStrQuadKey);
AddMapProvider('Virtual Earth Hybrid', ptEPSG3857, 'http://h%serv%.ortho.tiles.virtualearth.net/tiles/h%x%.jpg?g=72&shading=hill', 1, 19, 4, nil, @GetStrQuadKey); AddMapProvider('Virtual Earth Hybrid', ptEPSG3857, TILE_SIZE_256, 'http://h%serv%.ortho.tiles.virtualearth.net/tiles/h%x%.jpg?g=72&shading=hill', 1, 19, 4, nil, @GetStrQuadKey);
// 2GIS (Russian labels, limited zoom range) // 2GIS (Russian labels, limited zoom range)
AddMapProvider('2GIS', ptEPSG3857, 'http://tile%serv%.maps.2gis.com/tiles?x=%x%&y=%y%&z=%z%', 2, 18, 4, nil); // Reduced zoom levels tested... AddMapProvider('2GIS', ptEPSG3857, TILE_SIZE_256, 'http://tile%serv%.maps.2gis.com/tiles?x=%x%&y=%y%&z=%z%', 2, 18, 4, nil); // Reduced zoom levels tested...
if (HERE_AppID <> '') and (HERE_AppCode <> '') then begin if (HERE_AppID <> '') and (HERE_AppCode <> '') then begin
// Registration required to access HERE maps: // Registration required to access HERE maps:
@ -90,74 +94,74 @@ Some providers submitted by
// restart the demo. // restart the demo.
HERE1 := 'http://%serv%.base.maps.api.here.com/maptile/2.1/maptile/newest/'; HERE1 := 'http://%serv%.base.maps.api.here.com/maptile/2.1/maptile/newest/';
HERE2 := '/%z%/%x%/%y%/256/png8?app_id=' + HERE_AppID + '&app_code=' + HERE_AppCode; HERE2 := '/%z%/%x%/%y%/256/png8?app_id=' + HERE_AppID + '&app_code=' + HERE_AppCode;
AddMapProvider('Here WeGo Map', ptEPSG3857, HERE1 + 'normal.day' + HERE2, 1, 19, 4, @GetSvrBase1); AddMapProvider('Here WeGo Map', ptEPSG3857, TILE_SIZE_256, HERE1 + 'normal.day' + HERE2, 1, 19, 4, @GetSvrBase1);
AddMapProvider('Here WeGo Grey Map', ptEPSG3857, HERE1 + 'normal.day.grey' + HERE2, 1, 19, 4, @GetSvrBase1); AddMapProvider('Here WeGo Grey Map', ptEPSG3857, TILE_SIZE_256, HERE1 + 'normal.day.grey' + HERE2, 1, 19, 4, @GetSvrBase1);
AddMapProvider('Here WeGo Reduced Map', ptEPSG3857, HERE1 + 'reduced.day' + HERE2, 1, 19, 4, @GetSvrBase1); AddMapProvider('Here WeGo Reduced Map', ptEPSG3857, TILE_SIZE_256, HERE1 + 'reduced.day' + HERE2, 1, 19, 4, @GetSvrBase1);
AddMapProvider('Here WeGo Transit Map', ptEPSG3857, HERE1 + 'normal.day.transit' + HERE2, 1, 19, 4, @GetSvrBase1); AddMapProvider('Here WeGo Transit Map', ptEPSG3857, TILE_SIZE_256, HERE1 + 'normal.day.transit' + HERE2, 1, 19, 4, @GetSvrBase1);
AddMapProvider('Here WeGo POI Map', ptEPSG3857, HERE1 + 'normal.day' + HERE2 + '&pois', 1, 19, 4, @GetSvrBase1); AddMapProvider('Here WeGo POI Map', ptEPSG3857, TILE_SIZE_256, HERE1 + 'normal.day' + HERE2 + '&pois', 1, 19, 4, @GetSvrBase1);
AddMapProvider('Here WeGo Pedestrian Map', ptEPSG3857, HERE1 + 'pedestrian.day' + HERE2, 1, 19, 4, @GetSvrBase1); AddMapProvider('Here WeGo Pedestrian Map', ptEPSG3857, TILE_SIZE_256, HERE1 + 'pedestrian.day' + HERE2, 1, 19, 4, @GetSvrBase1);
AddMapProvider('Here WeGo DreamWorks Map', ptEPSG3857, HERE1 + 'normal.day' + HERE2 + '&style=dreamworks', 1, 19, 4, @GetSvrBase1); AddMapProvider('Here WeGo DreamWorks Map', ptEPSG3857, TILE_SIZE_256, HERE1 + 'normal.day' + HERE2 + '&style=dreamworks', 1, 19, 4, @GetSvrBase1);
end; end;
if (OpenWeatherMap_ApiKey <> '') then begin if (OpenWeatherMap_ApiKey <> '') then begin
// Registration required to access OpenWeatherMaps // Registration required to access OpenWeatherMaps
// https://home.openweathermap.org/users/sign_up // https://home.openweathermap.org/users/sign_up
// Store the API key found on the website in the ini file of the demo under key [OpenWeatherMap] and API_Key and restart the demo // Store the API key found on the website in the ini file of the demo under key [OpenWeatherMap] and API_Key and restart the demo
AddMapProvider('OpenWeatherMap Clouds', ptEPSG3857, 'https://tile.openweathermap.org/map/clouds_new/%z%/%x%/%y%.png?appid=' + OpenWeatherMap_ApiKey, 1, 19, 1, nil); AddMapProvider('OpenWeatherMap Clouds', ptEPSG3857, TILE_SIZE_256, 'https://tile.openweathermap.org/map/clouds_new/%z%/%x%/%y%.png?appid=' + OpenWeatherMap_ApiKey, 1, 19, 1, nil);
AddMapProvider('OpenWeatherMap Precipitation', ptEPSG3857, 'https://tile.openweathermap.org/map/precipitation_new/%z%/%x%/%y%.png?appid=' + OpenWeatherMap_ApiKey, 1, 19, 1, nil); AddMapProvider('OpenWeatherMap Precipitation', ptEPSG3857, TILE_SIZE_256, 'https://tile.openweathermap.org/map/precipitation_new/%z%/%x%/%y%.png?appid=' + OpenWeatherMap_ApiKey, 1, 19, 1, nil);
AddMapProvider('OpenWeatherMap Pressure', ptEPSG3857, 'https://tile.openweathermap.org/map/pressure_new/%z%/%x%/%y%.png?appid=' + OpenWeatherMap_ApiKey, 1, 19, 1, nil); AddMapProvider('OpenWeatherMap Pressure', ptEPSG3857, TILE_SIZE_256, 'https://tile.openweathermap.org/map/pressure_new/%z%/%x%/%y%.png?appid=' + OpenWeatherMap_ApiKey, 1, 19, 1, nil);
AddMapProvider('OpenWeatherMap Temperature', ptEPSG3857, 'https://tile.openweathermap.org/map/temp_new/%z%/%x%/%y%.png?appid=' + OpenWeatherMap_ApiKey, 1, 19, 1, nil); AddMapProvider('OpenWeatherMap Temperature', ptEPSG3857, TILE_SIZE_256, 'https://tile.openweathermap.org/map/temp_new/%z%/%x%/%y%.png?appid=' + OpenWeatherMap_ApiKey, 1, 19, 1, nil);
AddMapProvider('OpenWeatherMap Wind', ptEPSG3857, 'https://tile.openweathermap.org/map/wind_new/%z%/%x%/%y%.png?appid=' + OpenWeatherMap_ApiKey, 1, 19, 1, nil); AddMapProvider('OpenWeatherMap Wind', ptEPSG3857, TILE_SIZE_256, 'https://tile.openweathermap.org/map/wind_new/%z%/%x%/%y%.png?appid=' + OpenWeatherMap_ApiKey, 1, 19, 1, nil);
end; end;
{ {
// The following maps need hybrid overlays // The following maps need hybrid overlays
AddMapProvider('Google Hybrid', ptEPSG3857, 'http://mt%serv%.google.com/vt/lyrs=h@145&v=w2.104&x=%x%&y=%y%&z=%z%', 0, 19, 4, nil); AddMapProvider('Google Hybrid', ptEPSG3857, TILE_SIZE_256, 'http://mt%serv%.google.com/vt/lyrs=h@145&v=w2.104&x=%x%&y=%y%&z=%z%', 0, 19, 4, nil);
AddMapProvider('Google Physical', ptEPSG3857, 'http://mt%serv%.google.com/vt/lyrs=t@145&v=w2.104&x=%x%&y=%y%&z=%z%', 0, 19, 4, nil); AddMapProvider('Google Physical', ptEPSG3857, TILE_SIZE_256, 'http://mt%serv%.google.com/vt/lyrs=t@145&v=w2.104&x=%x%&y=%y%&z=%z%', 0, 19, 4, nil);
AddMapProvider('Yandex.Maps Hybrid', ptEPSG3395, 'https://vec0%serv%.maps.yandex.net/tiles?l=skl&x=%x%&y=%y%&z=%z%', 0, 19, 4, @GetSvrBase1, nil, nil, nil); AddMapProvider('Yandex.Maps Hybrid', ptEPSG3395, TILE_SIZE_256, 'https://vec0%serv%.maps.yandex.net/tiles?l=skl&x=%x%&y=%y%&z=%z%', 0, 19, 4, @GetSvrBase1, nil, nil, nil);
} }
// ArcGIS // ArcGIS
AddMapProvider('ArcGIS World Street Map', ptEPSG3857, 'http://server.arcgisonline.com/ArcGIS/rest/services/World_Street_Map/MapServer/tile/%z%/%y%/%x%.jpg', 0, 19, 4, nil); AddMapProvider('ArcGIS World Street Map', ptEPSG3857, TILE_SIZE_256, 'http://server.arcgisonline.com/ArcGIS/rest/services/World_Street_Map/MapServer/tile/%z%/%y%/%x%.jpg', 0, 19, 4, nil);
AddMapProvider('ArcGIS World Shaded Relief', ptEPSG3857, 'http://server.arcgisonline.com/ArcGIS/rest/services/World_Shaded_Relief/MapServer/tile/%z%/%y%/%x%.jpg', 0, 19, 4, nil); AddMapProvider('ArcGIS World Shaded Relief', ptEPSG3857, TILE_SIZE_256, 'http://server.arcgisonline.com/ArcGIS/rest/services/World_Shaded_Relief/MapServer/tile/%z%/%y%/%x%.jpg', 0, 19, 4, nil);
// AddMapProvider('ArcGIS World Physical Map', ptEPSG3857, 'http://server.arcgisonline.com/ArcGIS/rest/services/World_Physical_Map/MapServer/tile/%z%/%y%/%x%.jpg', 0, 19, 4, nil); --- not yet available // AddMapProvider('ArcGIS World Physical Map', ptEPSG3857, TILE_SIZE_256, 'http://server.arcgisonline.com/ArcGIS/rest/services/World_Physical_Map/MapServer/tile/%z%/%y%/%x%.jpg', 0, 19, 4, nil); --- not yet available
AddMapProvider('ArcGIS NatGeo World Map', ptEPSG3857, 'http://services.arcgisonline.com/ArcGIS/rest/services/NatGeo_World_Map/MapServer/tile/%z%/%y%/%x%', 0, 19, 4, nil); AddMapProvider('ArcGIS NatGeo World Map', ptEPSG3857, TILE_SIZE_256, 'http://services.arcgisonline.com/ArcGIS/rest/services/NatGeo_World_Map/MapServer/tile/%z%/%y%/%x%', 0, 19, 4, nil);
// AddMapProvider('ArcGIS Ocean Base', ptEPSG3857, 'http://services.arcgisonline.com/ArcGIS/rest/services/Ocean/World_Ocean_Base/MapServer/tile/%z%/%y%/%x%.jpg', 0, 19, 4, nil); // --- not yet available // AddMapProvider('ArcGIS Ocean Base', ptEPSG3857, TILE_SIZE_256, 'http://services.arcgisonline.com/ArcGIS/rest/services/Ocean/World_Ocean_Base/MapServer/tile/%z%/%y%/%x%.jpg', 0, 19, 4, nil); // --- not yet available
// AddMapProvider('ArcGIS Imagery', ptEPSG3857, 'http://services.arcgisonline.com/ArcGIS/rest/services/Ocean/World_Ocean_Base/MapServer/tile/%z%/%y%/%x%.jpg', 0, 19, 4, nil); // not available // AddMapProvider('ArcGIS Imagery', ptEPSG3857, TILE_SIZE_256, 'http://services.arcgisonline.com/ArcGIS/rest/services/Ocean/World_Ocean_Base/MapServer/tile/%z%/%y%/%x%.jpg', 0, 19, 4, nil); // not available
AddMapProvider('ArcGIS Clarity', ptEPSG3857, 'https://clarity.maptiles.arcgis.com/arcgis/rest/services/World_Imagery/MapServer/tile/%z%/%y%/%x%?blankTile=false', 0, 19, 4, nil); AddMapProvider('ArcGIS Clarity', ptEPSG3857, TILE_SIZE_256, 'https://clarity.maptiles.arcgis.com/arcgis/rest/services/World_Imagery/MapServer/tile/%z%/%y%/%x%?blankTile=false', 0, 19, 4, nil);
// Apple // Apple
// AddMapProvider('GSP2 Apple', ptEPSG3857, 'http://gsp2.apple.com/tile?api=1&style=slideshow&layers=default&lang=de_DE&z=%z%&x=%x%&y=%y%&v=9', 0, 19, 4, nil); // AddMapProvider('GSP2 Apple', ptEPSG3857, TILE_SIZE_256, 'http://gsp2.apple.com/tile?api=1&style=slideshow&layers=default&lang=de_DE&z=%z%&x=%x%&y=%y%&v=9', 0, 19, 4, nil);
// CartoDB // CartoDB
AddMapProvider('CartoDB Light All', ptEPSG3857, 'https://cartodb-basemaps-a.global.ssl.fastly.net/light_all/%z%/%x%/%y%.png', 0, 19, 4, nil); AddMapProvider('CartoDB Light All', ptEPSG3857, TILE_SIZE_256, 'https://cartodb-basemaps-a.global.ssl.fastly.net/light_all/%z%/%x%/%y%.png', 0, 19, 4, nil);
AddMapProvider('CartoDB Voyager', ptEPSG3857, 'https://cartodb-basemaps-a.global.ssl.fastly.net/rastertiles/voyager/%z%/%x%/%y%.png', 0, 19, 4, nil); AddMapProvider('CartoDB Voyager', ptEPSG3857, TILE_SIZE_256, 'https://cartodb-basemaps-a.global.ssl.fastly.net/rastertiles/voyager/%z%/%x%/%y%.png', 0, 19, 4, nil);
// "Maps for free" // "Maps for free"
AddMapProvider('Maps For Free', ptEPSG3857, 'http://maps-for-free.com/layer/relief/z%z%/row%y%/%z%_%x%-%y%.jpg', 0, 19, 4, nil); AddMapProvider('Maps For Free', ptEPSG3857, TILE_SIZE_256, 'http://maps-for-free.com/layer/relief/z%z%/row%y%/%z%_%x%-%y%.jpg', 0, 19, 4, nil);
// MemoMaps // MemoMaps
AddMapProvider('Memo Maps', ptEPSG3857,'http://tile.memomaps.de/tilegen/%z%/%x%/%y%.png', 0, 19, 4, nil); AddMapProvider('Memo Maps', ptEPSG3857, TILE_SIZE_256, 'http://tile.memomaps.de/tilegen/%z%/%x%/%y%.png', 0, 19, 4, nil);
// Sigma DC Control // Sigma DC Control
//AddMapProvider('Sigma DC Control', ptEPSG3857,'http://tiles1.sigma-dc-control.com/layer5/%z%/%x%/%y%.png', 0, 19, 4, nil); // -- not working //AddMapProvider('Sigma DC Control', ptEPSG3857, TILE_SIZE_256, 'http://tiles1.sigma-dc-control.com/layer5/%z%/%x%/%y%.png', 0, 19, 4, nil); // -- not working
// Stamen // Stamen
AddMapProvider('Stamen Terrain', ptEPSG3857, 'http://tile.stamen.com/terrain/%z%/%x%/%y%.jpg', 0, 19, 4, nil); AddMapProvider('Stamen Terrain', ptEPSG3857, TILE_SIZE_256, 'http://tile.stamen.com/terrain/%z%/%x%/%y%.jpg', 0, 19, 4, nil);
AddMapProvider('Stamen Watercolor', ptEPSG3857, 'https://stamen-tiles.a.ssl.fastly.net/watercolor/%z%/%x%/%y%.jpg' , 0, 19, 4, nil); AddMapProvider('Stamen Watercolor', ptEPSG3857, TILE_SIZE_256, 'https://stamen-tiles.a.ssl.fastly.net/watercolor/%z%/%x%/%y%.jpg' , 0, 19, 4, nil);
// Via Michelin // Via Michelin
AddMapProvider('ViaMichelin', ptEPSG3857, 'http://map1.viamichelin.com/map/mapdirect?map=light&z=%z%&x=%x%&y=%y%&format=png&version=201503191157&layer=background', 0, 19, 4, nil); AddMapProvider('ViaMichelin', ptEPSG3857, TILE_SIZE_256, 'http://map1.viamichelin.com/map/mapdirect?map=light&z=%z%&x=%x%&y=%y%&format=png&version=201503191157&layer=background', 0, 19, 4, nil);
// GeoApify // GeoApify
//AddMapProvider('Geoapify Map Tiles', ptEPSG3857, 'https://maps.geoapify.com/v1/tile/osm-bright-smooth/%z%/%x%/%y%.png' , 0, 19, 4, nil); // -- not working //AddMapProvider('Geoapify Map Tiles', ptEPSG3857, TILE_SIZE_256, 'https://maps.geoapify.com/v1/tile/osm-bright-smooth/%z%/%x%/%y%.png' , 0, 19, 4, nil); // -- not working
// Stadia outdoors // Stadia outdoors
// AddMapProvider('Stadia Outdoors', ptEPSG3857, 'https://tiles.stadiamaps.com/tiles/outdoors/%z%/%x%/%y%.png', 0, 19, 4, nil); -- subscription required // AddMapProvider('Stadia Outdoors', ptEPSG3857, TILE_SIZE_256, 'https://tiles.stadiamaps.com/tiles/outdoors/%z%/%x%/%y%.png', 0, 19, 4, nil); -- subscription required
// Tracestrack // Tracestrack
//AddMapProvider('Tracestrack Carto', ptEPSG3857, 'https://tile.tracestrack.com/en/%z%/%x%/%y%.png,' , 0, 19, 4, nil); // -- not working //AddMapProvider('Tracestrack Carto', ptEPSG3857, TILE_SIZE_256, 'https://tile.tracestrack.com/en/%z%/%x%/%y%.png,' , 0, 19, 4, nil); // -- not working
// Waze // Waze
AddMapProvider('Waze Background', ptEPSG3857, 'https://worldtiles1.waze.com/tiles/%z%/%x%/%y%.png', 0, 19, 4, nil); AddMapProvider('Waze Background', ptEPSG3857, TILE_SIZE_256, 'https://worldtiles1.waze.com/tiles/%z%/%x%/%y%.png', 0, 19, 4, nil);

View File

@ -15,7 +15,7 @@ unit mvMapProvider;
interface interface
uses uses
Classes, SysUtils, laz2_dom; Classes, SysUtils, Types, laz2_dom;
type type
@ -58,17 +58,20 @@ type
FGetZStr: Array of TGetValStr; FGetZStr: Array of TGetValStr;
FMinZoom: Array of integer; FMinZoom: Array of integer;
FMaxZoom: Array of integer; FMaxZoom: Array of integer;
FTiles:array of TBaseTile; FTiles: Array of TBaseTile;
FTileHandling: TRTLCriticalSection; FTileHandling: TRTLCriticalSection;
FTileSize: Array of TSize;
function GetLayerCount: integer; function GetLayerCount: integer;
function GetProjectionType: TProjectionType; function GetProjectionType: TProjectionType;
function GetTileSize: TSize;
procedure SetLayer(AValue: integer); procedure SetLayer(AValue: integer);
public public
constructor Create(AName: String); constructor Create(AName: String);
destructor Destroy; override; destructor Destroy; override;
function AppendTile(aTile: TBaseTile): integer; function AppendTile(aTile: TBaseTile): integer;
procedure RemoveTile(aTile: TBaseTile); procedure RemoveTile(aTile: TBaseTile);
procedure AddURL(Url: String; ProjectionType: TProjectionType; NbSvr, aMinZoom, aMaxZoom: integer; procedure AddURL(Url: String; ProjectionType: TProjectionType;
ATileSize: TSize; NbSvr, aMinZoom, aMaxZoom: integer;
GetSvrStr: TGetSvrStr; GetXStr: TGetValStr; GetYStr: TGetValStr; GetSvrStr: TGetSvrStr; GetXStr: TGetValStr; GetYStr: TGetValStr;
GetZStr: TGetValStr); GetZStr: TGetValStr);
procedure GetZoomInfos(out AZoomMin, AZoomMax: integer); procedure GetZoomInfos(out AZoomMin, AZoomMax: integer);
@ -78,6 +81,7 @@ type
property LayerCount: integer read GetLayerCount; property LayerCount: integer read GetLayerCount;
property Layer: integer read FLayer write SetLayer; property Layer: integer read FLayer write SetLayer;
property ProjectionType: TProjectionType read GetProjectionType; property ProjectionType: TProjectionType read GetProjectionType;
property TileSize: TSize read GetTileSize;
end; end;
@ -98,7 +102,7 @@ const
implementation implementation
uses uses
TypInfo; TypInfo, mvTypes;
function GetSvrLetter(id: integer): String; function GetSvrLetter(id: integer): String;
begin begin
@ -169,6 +173,14 @@ begin
Result := FProjectionType[layer]; Result := FProjectionType[layer];
end; end;
function TMapProvider.GetTileSize: TSize;
begin
if Length(FTileSize) = 0 then
Result := TILE_SIZE_256
else
Result := FTileSize[layer];
end;
procedure TMapProvider.SetLayer(AValue: integer); procedure TMapProvider.SetLayer(AValue: integer);
begin begin
if FLayer = AValue then Exit; if FLayer = AValue then Exit;
@ -192,6 +204,7 @@ begin
Finalize(idServer); Finalize(idServer);
Finalize(FName); Finalize(FName);
Finalize(FProjectionType); Finalize(FProjectionType);
Finalize(FTileSize);
Finalize(FUrl); Finalize(FUrl);
Finalize(FNbSvr); Finalize(FNbSvr);
Finalize(FGetSvrStr); Finalize(FGetSvrStr);
@ -284,7 +297,7 @@ begin
end; end;
procedure TMapProvider.AddURL(Url: String; ProjectionType: TProjectionType; procedure TMapProvider.AddURL(Url: String; ProjectionType: TProjectionType;
NbSvr, aMinZoom, aMaxZoom: integer; GetSvrStr: TGetSvrStr; ATileSize: TSize; NbSvr, aMinZoom, aMaxZoom: integer; GetSvrStr: TGetSvrStr;
GetXStr: TGetValStr; GetYStr: TGetValStr; GetZStr: TGetValStr); GetXStr: TGetValStr; GetYStr: TGetValStr; GetZStr: TGetValStr);
var var
nb: integer; nb: integer;
@ -293,6 +306,7 @@ begin
SetLength(IdServer, nb); SetLength(IdServer, nb);
SetLength(FUrl, nb); SetLength(FUrl, nb);
SetLength(FProjectionType, nb); SetLength(FProjectionType, nb);
SetLength(FTileSize, nb);
SetLength(FNbSvr, nb); SetLength(FNbSvr, nb);
SetLength(FGetSvrStr, nb); SetLength(FGetSvrStr, nb);
SetLength(FGetXStr, nb); SetLength(FGetXStr, nb);
@ -303,6 +317,7 @@ begin
nb := High(FUrl); nb := High(FUrl);
FUrl[nb] := Url; FUrl[nb] := Url;
FProjectionType[nb] := ProjectionType; FProjectionType[nb] := ProjectionType;
FTileSize[nb] := ATileSize;
FNbSvr[nb] := NbSvr; FNbSvr[nb] := NbSvr;
FMinZoom[nb] := aMinZoom; FMinZoom[nb] := aMinZoom;
FMaxZoom[nb] := aMaxZoom; FMaxZoom[nb] := aMaxZoom;
@ -407,6 +422,9 @@ begin
s := ''; s := '';
if s <> '' then if s <> '' then
layerNode.SetAttribute('zProc', s); layerNode.SetAttribute('zProc', s);
s := Format('%d x %d', [FTileSize[i].CX, FTileSize[i].CY]);
layerNode.SetAttribute('tileSize', s);
end; end;
end; end;

View File

@ -2606,7 +2606,7 @@ const
Engine.Redraw; Engine.Redraw;
W := Canvas.Width; W := Canvas.Width;
if Cyclic then if Cyclic then
W := Min(1 shl Zoom * TILE_SIZE, W); W := Min(1 shl Zoom * Engine.TileSize.CX, W);
if Assigned(FBeforeDrawObjectsEvent) then if Assigned(FBeforeDrawObjectsEvent) then
FBeforeDrawObjectsEvent(Self); FBeforeDrawObjectsEvent(Self);
@ -2768,7 +2768,7 @@ begin
begin begin
L := Max(0, Engine.MapLeft); L := Max(0, Engine.MapLeft);
T := Max(0, Engine.MapTop); T := Max(0, Engine.MapTop);
WS := ZoomFactor(Zoom) * TILE_SIZE; WS := ZoomFactor(Zoom) * Engine.TileSize.CX;
ClipRect := Rect(L, T, Min(Engine.MapLeft + WS, ClientWidth), ClipRect := Rect(L, T, Min(Engine.MapLeft + WS, ClientWidth),
Min(Engine.MapTop + WS, ClientHeight)); Min(Engine.MapTop + WS, ClientHeight));
end; end;
@ -2836,7 +2836,7 @@ begin
if Cyclic then if Cyclic then
begin begin
WS := ZoomFactor(Zoom) * TILE_SIZE; WS := ZoomFactor(Zoom) * Engine.TileSize.CX; // To do: Fix case when tiles are not square
if (WS < ClientWidth) then if (WS < ClientWidth) then
begin begin
{TODO Draw multiple copies of the area} {TODO Draw multiple copies of the area}
@ -3070,11 +3070,14 @@ end;
procedure TMapView.DoDrawStretchedTile(const TileId: TTileID; X, Y: Integer; procedure TMapView.DoDrawStretchedTile(const TileId: TTileID; X, Y: Integer;
TileImg: TPictureCacheItem; const R: TRect); TileImg: TPictureCacheItem; const R: TRect);
var
tileSize: TSize;
begin begin
tileSize := Engine.TileSize;
if Assigned(TileImg) then if Assigned(TileImg) then
DrawingEngine.DrawScaledCacheItem(Rect(X, Y, X + TILE_SIZE, Y + TILE_SIZE), R, TileImg) DrawingEngine.DrawScaledCacheItem(Rect(X, Y, X + tileSize.CX, Y + tileSize.CY), R, TileImg)
else else
DrawingEngine.FillPixels(X, Y, X + TILE_SIZE, Y + TILE_SIZE, InactiveColor); DrawingEngine.FillPixels(X, Y, X + tileSize.CY, Y + tileSize.CY, InactiveColor);
if FDebugTiles then if FDebugTiles then
DoDrawTileInfo(TileID, X, Y); DoDrawTileInfo(TileID, X, Y);
@ -3083,25 +3086,32 @@ end;
procedure TMapView.DoDrawTile(const TileId: TTileId; X, Y: integer; procedure TMapView.DoDrawTile(const TileId: TTileId; X, Y: integer;
TileImg: TPictureCacheItem); TileImg: TPictureCacheItem);
var
tileSize: TSize;
begin begin
if Assigned(TileImg) then if Assigned(TileImg) then
DrawingEngine.DrawCacheItem(X, Y, TileImg) DrawingEngine.DrawCacheItem(X, Y, TileImg)
else else
DrawingEngine.FillPixels(X, Y, X + TILE_SIZE, Y + TILE_SIZE, InactiveColor); begin
tileSize := Engine.TileSize;
DrawingEngine.FillPixels(X, Y, X + tileSize.CX, Y + tileSize.CY, InactiveColor);
end;
if FDebugTiles then if FDebugTiles then
DoDrawTileInfo(TileID, X, Y); DoDrawTileInfo(TileID, X, Y);
end; end;
procedure TMapView.DoDrawTileInfo(const TileID: TTileID; X, Y: Integer); procedure TMapView.DoDrawTileInfo(const TileID: TTileID; X, Y: Integer);
var
tileSize: TSize;
begin begin
tileSize := Engine.TileSize;
DrawingEngine.PenColor := clGray; DrawingEngine.PenColor := clGray;
DrawingEngine.PenWidth := 1; DrawingEngine.PenWidth := 1;
DrawingEngine.Line(X, Y, X, Y + TILE_SIZE); DrawingEngine.Line(X, Y, X, Y + tileSize.CY);
DrawingEngine.Line(X, Y, X + TILE_SIZE, Y); DrawingEngine.Line(X, Y, X + tileSize.CX, Y);
DrawingEngine.Line(X + TILE_SIZE, Y, X + TILE_SIZE, Y + TILE_SIZE); DrawingEngine.Line(X + tileSize.CX, Y, X + tileSize.CX, Y + tileSize.CY);
DrawingEngine.Line(X, Y + TILE_SIZE, X + TILE_SIZE, Y + TILE_SIZE); DrawingEngine.Line(X, Y + tileSize.CY, X + tileSize.CX, Y + tileSize.CY);
end; end;
procedure TMapView.DoEraseBackground(const R: TRect); procedure TMapView.DoEraseBackground(const R: TRect);
@ -3248,7 +3258,7 @@ var
WorldSize: Int64; WorldSize: Int64;
begin begin
Result := APoint; Result := APoint;
WorldSize := ZoomFactor(Zoom) * TILE_SIZE; WorldSize := ZoomFactor(Zoom) * Engine.TileSize.CX;
if Eastwards then if Eastwards then
begin begin
while Result.X < ARefX do while Result.X < ARefX do
@ -3277,7 +3287,7 @@ begin
end end
else else
begin begin
WorldSize := ZoomFactor(Zoom) * TILE_SIZE; WorldSize := ZoomFactor(Zoom) * Engine.TileSize.CX;
CanvasWidth := Canvas.Width; CanvasWidth := Canvas.Width;
SetLength(Result, 1{APoint} + (1{Round} + CanvasWidth div WorldSize)); SetLength(Result, 1{APoint} + (1{Round} + CanvasWidth div WorldSize));
Result[0] := APoint; Result[0] := APoint;
@ -3447,7 +3457,7 @@ begin
Result.BottomRight := Engine.ScreenToLatLon(Point(Width, Height)); Result.BottomRight := Engine.ScreenToLatLon(Point(Width, Height));
if Cyclic then if Cyclic then
begin begin
mapWidth := ZoomFactor(Engine.Zoom) * TILE_SIZE; mapWidth := ZoomFactor(Engine.Zoom) * Engine.TileSize.CX;
if Width >= mapWidth then if Width >= mapWidth then
begin begin
Result.TopLeft.Lon := -180; Result.TopLeft.Lon := -180;
@ -3727,21 +3737,23 @@ var
X, Y, Z, W, H: Integer; X, Y, Z, W, H: Integer;
S: String; S: String;
extent: TSize; extent: TSize;
tileSize: TSize;
begin begin
inherited Draw(AView, Area); inherited Draw(AView, Area);
V := FParentView; V := FParentView;
PtTL := V.Engine.LatLonToWorldScreen(Area.TopLeft); PtTL := V.Engine.LatLonToWorldScreen(Area.TopLeft);
PtBR := V.Engine.LatLonToWorldScreen(Area.BottomRight); PtBR := V.Engine.LatLonToWorldScreen(Area.BottomRight);
X := -PtTL.X div TILE_SIZE; tileSize := V.Engine.TileSize;
Y := -PtTL.Y div TILE_SIZE; X := -PtTL.X div tileSize.CX;
Pt0 := Point(V.Engine.MapLeft + X * TILE_SIZE, Y := -PtTL.Y div tileSize.CY;
V.Engine.MapTop + Y * TILE_SIZE); Pt0 := Point(V.Engine.MapLeft + X * tileSize.CX,
V.Engine.MapTop + Y * tileSize.CY);
Pt := Pt0; Pt := Pt0;
H := Y + (PtBR.Y - PtTL.Y) div TILE_SIZE; H := Y + (PtBR.Y - PtTL.Y) div tileSize.CY;
while Y <= H do while Y <= H do
begin begin
X := -PtTL.X div TILE_SIZE; X := -PtTL.X div tileSize.CX;
W := X + (PtBR.X - PtTL.X) div TILE_SIZE; W := X + (PtBR.X - PtTL.X) div tileSize.CX;
while X <= W do while X <= W do
begin begin
Z := V.Zoom; Z := V.Zoom;
@ -3749,13 +3761,13 @@ begin
V.DrawingEngine.BrushColor := clCream; V.DrawingEngine.BrushColor := clCream;
S := Format(' %d-%d-%d ', [X, Y, Z]); S := Format(' %d-%d-%d ', [X, Y, Z]);
extent := V.DrawingEngine.TextExtent(S); extent := V.DrawingEngine.TextExtent(S);
V.DrawingEngine.TextOut(Pt.X + (TILE_SIZE - extent.CX) div 2, V.DrawingEngine.TextOut(Pt.X + (tileSize.CX - extent.CX) div 2,
Pt.Y + (TILE_SIZE - extent.CY) div 2, S); Pt.Y + (tileSize.CY - extent.CY) div 2, S);
Inc(Pt.X, TILE_SIZE); Inc(Pt.X, tileSize.CX);
Inc(X); Inc(X);
end; end;
Pt.X := Pt0.X; Pt.X := Pt0.X;
Inc(Pt.Y, TILE_SIZE); Inc(Pt.Y, tileSize.CY);
Inc(Y); Inc(Y);
end; end;
end; end;

View File

@ -15,12 +15,13 @@ unit mvTypes;
interface interface
uses uses
Classes, SysUtils, Math; Classes, SysUtils, Math, Types;
const const
TILE_SIZE = 256;
PALETTE_PAGE = 'Misc'; PALETTE_PAGE = 'Misc';
DEFAULT_POI_TEXT_WIDTH = 300; DEFAULT_POI_TEXT_WIDTH = 300;
TILE_SIZE_256: TSize = (CX: 256; CY: 256);
TILE_SIZE_512: TSize = (CX: 512; CY: 512);
Type Type
{ TArea } { TArea }