paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

LazMapViewer: Undo r9494, not usable. Scale all tiles to the size specified by global TileSize variable. Alpha-channel of RGB32BBitmap and BGRABitmap drawing engines not correct, so far. (Issue #39078).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9497 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2024-11-04 17:20:17 +00:00
parent 188553b343
commit 244c9fa2b2
9 changed files with 242 additions and 232 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
components/lazmapviewer/source/addons/bgra_drawingengine/mvde_bgra.pas
View File

@ -31,6 +31,7 @@ type
function GetImage: TBGRABitmap; function GetImage: TBGRABitmap;
protected protected
function GetImageObject: TObject; override; function GetImageObject: TObject; override;
procedure StretchImageIfNeeded(var AImage: TBGRABitmap; ANewWidth, ANewHeight: Integer);
public public
constructor Create(AStream: TStream); override; constructor Create(AStream: TStream); override;
destructor Destroy; override; destructor Destroy; override;
@ -131,6 +132,8 @@ begin
FImage := TBGRABitmap.Create; FImage := TBGRABitmap.Create;
try try
FImage.LoadFromStream(AStream, Reader); FImage.LoadFromStream(AStream, Reader);
// Make sure that all tiles have the size defined by TileSize.
StretchImageIfNeeded(FImage, TileSize.CX, TileSize.CY);
except except
FreeAndNil(FImage); FreeAndNil(FImage);
end; end;
@ -139,6 +142,29 @@ begin
end; end;
end; end;
procedure TBGRABitmapCacheItem.StretchImageIfNeeded(var AImage: TBGRABitmap;
ANewWidth, ANewHeight: Integer);
var
img: TBGRABitmap;
w, h: Integer;
Rsrc, Rdst: TRect;
begin
if AImage = nil then
exit;
w := AImage.Width;
h := AImage.Height;
if (w <> ANewWidth) or (h <> ANewHeight) then
begin
img := TBGRABitmap.Create(ANewWidth, ANewHeight);
Rsrc := Rect(0, 0, AImage.Width, AImage.Height);
Rdst := Rect(0, 0, ANewWidth, ANewHeight);
img.CanvasBGRA.CopyRect(Rdst, AImage, Rsrc);
AImage.Free;
AImage := img;
end;
end;
destructor TBGRABitmapCacheItem.Destroy; destructor TBGRABitmapCacheItem.Destroy;
begin begin
FImage.Free; FImage.Free;

22
components/lazmapviewer/source/addons/rgbgraphics_drawingengine/mvde_rgbgraphics.pas
View File

@ -31,6 +31,7 @@ type
function GetImage: TRGB32Bitmap; function GetImage: TRGB32Bitmap;
protected protected
function GetImageObject: TObject; override; function GetImageObject: TObject; override;
procedure StretchImageIfNeeded(var AImage: TRGB32Bitmap; ANewWidth, ANewHeight: Integer);
public public
constructor Create(AStream: TStream); override; constructor Create(AStream: TStream); override;
destructor Destroy; override; destructor Destroy; override;
@ -277,6 +278,8 @@ begin
try try
try try
FImage := TRGB32Bitmap.CreateFromStream(AStream, Reader); FImage := TRGB32Bitmap.CreateFromStream(AStream, Reader);
// Make sure that all tiles have the size defined by TileSize.
StretchImageIfNeeded(FImage, TileSize.CX, TileSize.CY);
except except
FreeAndNil(FImage); FreeAndNil(FImage);
end; end;
@ -291,6 +294,25 @@ begin
inherited Destroy; inherited Destroy;
end; end;
{ Scales the image to the new size if the original size is different.
Needed to have all tiles at the same size. }
procedure TRGB32BitmapCacheItem.StretchImageIfNeeded(var AImage: TRGB32Bitmap;
ANewWidth, ANewHeight: Integer);
var
w, h: Integer;
begin
if AImage = nil then
exit;
w := AImage.Width;
h := AImage.Height;
if (w <> ANewWidth) or (h <> ANewHeight) then
begin
// AImage.SaveToFile('test512.png');
AImage.StretchTrunc(ANewWidth, ANewHeight);
// AImage.SaveToFile('test256.png');
end;
end;
destructor TMvRGBGraphicsDrawingEngine.Destroy; destructor TMvRGBGraphicsDrawingEngine.Destroy;
begin begin
FBuffer.Free; FBuffer.Free;

18
components/lazmapviewer/source/mvcache.pas
View File

@ -17,22 +17,19 @@ unit mvCache;
interface interface
uses uses
Classes, SysUtils, Types, FPImage, IntfGraphics, syncObjs, Classes, SysUtils, IntfGraphics, syncObjs,
mvMapProvider, mvTypes; mvMapProvider, mvTypes, FPImage;
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;
@ -49,7 +46,6 @@ 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;
@ -75,7 +71,6 @@ 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;
@ -346,7 +341,6 @@ 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);
@ -358,7 +352,6 @@ 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;
@ -446,8 +439,7 @@ 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;
FTileSize := MapProvider.TileSize; w := TileSize.CX;
w := tileSize.CX;
repeat repeat
w := w shr 1; w := w shr 1;
dec(ltid.Z); dec(ltid.Z);
@ -460,8 +452,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 * FTileSize.CX); //x and y are the percentage of the tile width px := Trunc(xfrac * TileSize.CX); //x and y are the percentage of the tile width
py := Trunc(yfrac * FTileSize.CY); py := Trunc(yfrac * TileSize.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;

30
components/lazmapviewer/source/mvde_intfgraphics.pas
View File

@ -30,6 +30,7 @@ type
function GetImage: TLazIntfImage; function GetImage: TLazIntfImage;
protected protected
function GetImageObject: TObject; override; function GetImageObject: TObject; override;
procedure StretchImageIfNeeded(var AImage: TLazIntfImage; ANewWidth, ANewHeight: Integer);
public public
constructor Create(AStream: TStream); override; constructor Create(AStream: TStream); override;
destructor Destroy; override; destructor Destroy; override;
@ -195,10 +196,12 @@ 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(TileSize.CX, TileSize.CY); rawImg.Description.Init_BPP32_B8G8R8A8_BIO_TTB(0, 0);
FImage := TLazIntfImage.Create(rawImg, True); FImage := TLazIntfImage.Create(rawImg, True);
try try
FImage.LoadFromStream(AStream, Reader); FImage.LoadFromStream(AStream, Reader);
// Make sure that all tiles have the size defined by TileSize.
StretchImageIfNeeded(FImage, TileSize.CX, TileSize.CY);
except except
FreeAndNil(FImage); FreeAndNil(FImage);
end; end;
@ -213,6 +216,31 @@ begin
inherited Destroy; inherited Destroy;
end; end;
procedure TLazIntfImageCacheItem.StretchImageIfNeeded(var AImage: TLazIntfImage;
ANewWidth, ANewHeight: Integer);
var
img: TLazIntfImage;
canv: TLazCanvas;
begin
if AImage = nil then
exit;
if (AImage.Width <> ANewWidth) or (AImage.Height <> ANewHeight) then
begin
img := TLazIntfImage.CreateCompatible(AImage, ANewWidth, ANewHeight);
canv := TLazCanvas.Create(img);
try
canv.Interpolation := TFPSharpInterpolation.Create;
canv.StretchDraw(0, 0, ANewWidth, ANewHeight, AImage);
AImage.Free;
AImage := img;
finally
canv.Interpolation.Free;
canv.Interpolation := nil;
canv.Free;
end;
end;
end;
{ TMvIntfGraphicsDrawingengine } { TMvIntfGraphicsDrawingengine }

129
components/lazmapviewer/source/mvengine.pas
View File

@ -20,7 +20,7 @@ unit mvEngine;
interface interface
uses uses
Classes, SysUtils, Types, IntfGraphics, Controls, Math, GraphType, FPImage, Classes, SysUtils, IntfGraphics, Controls, Math, GraphType, FPImage,
mvTypes, mvGeoMath, mvJobQueue, mvMapProvider, mvDownloadEngine, mvCache, mvDragObj; mvTypes, mvGeoMath, mvJobQueue, mvMapProvider, mvDownloadEngine, mvCache, mvDragObj;
type type
@ -125,7 +125,6 @@ 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);
@ -141,9 +140,9 @@ type
constructor Create(aOwner: TComponent); override; constructor Create(aOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
function AddMapProvider(OpeName: String; ProjectionType: TProjectionType; function AddMapProvider(OpeName: String; ProjectionType: TProjectionType; Url: String;
ATileSize: TSize; Url: String; MinZoom, MaxZoom, NbSvr: integer; MinZoom, MaxZoom, NbSvr: integer; GetSvrStr: TGetSvrStr = nil;
GetSvrStr: TGetSvrStr = nil; GetXStr: TGetValStr = nil; GetYStr: TGetValStr = nil; GetXStr: TGetValStr = nil; GetYStr: TGetValStr = nil;
GetZStr: TGetValStr = nil): TMapProvider; GetZStr: TGetValStr = nil): TMapProvider;
procedure CancelCurrentDrawing; procedure CancelCurrentDrawing;
procedure ClearMapProviders; procedure ClearMapProviders;
@ -188,7 +187,6 @@ 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;
@ -321,7 +319,7 @@ begin
end; end;
function TMapViewerEngine.AddMapProvider(OpeName: String; ProjectionType: TProjectionType; function TMapViewerEngine.AddMapProvider(OpeName: String; ProjectionType: TProjectionType;
ATileSize: TSize; Url: String; MinZoom, MaxZoom, NbSvr: integer; GetSvrStr: TGetSvrStr; 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;
@ -334,7 +332,7 @@ Begin
end end
else else
Result := TMapProvider(lstProvider.Objects[idx]); Result := TMapProvider(lstProvider.Objects[idx]);
Result.AddUrl(Url, ProjectionType, ATileSize, NbSvr, MinZoom, MaxZoom, GetSvrStr, GetXStr, GetYStr, GetZStr); Result.AddUrl(Url, ProjectionType, NbSvr, MinZoom, MaxZoom, GetSvrStr, GetXStr, GetYStr, GetZStr);
end; end;
procedure TMapViewerEngine.AdjustZoomCenter(var AWin: TMapWindow); procedure TMapViewerEngine.AdjustZoomCenter(var AWin: TMapWindow);
@ -354,22 +352,20 @@ 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;
tileSz := TileSize; MaxX := Int64(aWin.Width) div TileSize.CX + 1;
MaxX := Int64(aWin.Width) div tileSz.CX + 1; MaxY := Int64(aWin.Height) div TileSize.CY + 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 tileSz.CX; startX := -aWin.X div TileSize.CX;
startY := -aWin.Y div tileSz.CY; startY := -aWin.Y div TileSize.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);
@ -623,14 +619,6 @@ 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;
@ -681,7 +669,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) * TileSize.CX; mapWidth := mvGeoMath.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
@ -702,7 +690,6 @@ const
var var
factorX, factorY, 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
@ -710,9 +697,8 @@ 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);
tileSz := TileSize; factorX := TileSize.CX / TWO_PI * mvGeoMath.ZoomFactor(AWin.Zoom);
factorX := tileSz.CX / TWO_PI * ZoomFactor(AWin.Zoom); factorY := TileSize.CY / TWO_PI * mvGeoMath.ZoomFactor(AWin.Zoom);
factorY := tileSz.CY / TWO_PI * ZoomFactor(AWin.Zoom);
px := factorX * (pt.LonRad + pi); px := factorX * (pt.LonRad + pi);
py := factorY * (pi - ln( tan(pi/4 + pt.LatRad/2) )); py := factorY * (pi - ln( tan(pi/4 + pt.LatRad/2) ));
@ -783,7 +769,7 @@ var
mPoint : TPoint; mPoint : TPoint;
PType: TProjectionType; PType: TProjectionType;
begin begin
mapWidth := round(mvGeoMath.ZoomFactor(AWin.Zoom)) * TileSize.CX; mapWidth := round(mvGeoMath.ZoomFactor(AWin.Zoom) * TileSize.CX);
if FCyclic then if FCyclic then
begin begin
@ -812,7 +798,6 @@ 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
@ -821,9 +806,8 @@ 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);
tileSz := TileSize; Result.LonRad := ( APoint.X / (( TileSize.CX / (2*pi)) * zoomFac) ) - pi;
Result.LonRad := ( APoint.X / (( tileSz.CX / (2*pi)) * zoomFac) ) - pi; Result.LatRad := arctan( sinh(pi - (APoint.Y / TileSize.CY) / zoomFac * pi*2) );
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);
@ -994,22 +978,6 @@ 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;
@ -1026,7 +994,6 @@ var
yProc: String; yProc: String;
zProc: String; zProc: String;
first: Boolean; first: Boolean;
tileSz: TSize;
begin begin
Result := false; Result := false;
AMsg := ''; AMsg := '';
@ -1059,7 +1026,6 @@ 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');
@ -1070,7 +1036,7 @@ begin
ClearMapProviders; ClearMapProviders;
first := false; first := false;
end; end;
AddMapProvider(providerName, projectionType, tileSz, AddMapProvider(providerName, projectionType,
url, minZoom, maxZoom, svrCount, url, minZoom, maxZoom, svrCount,
GetSvrStr(svrProc), GetValStr(xProc), GetValStr(yProc), GetValStr(zProc) GetSvrStr(svrProc), GetValStr(xProc), GetValStr(yProc), GetValStr(zProc)
); );
@ -1099,7 +1065,6 @@ var
previewDrawn: Boolean; previewDrawn: Boolean;
previewImg: TPictureCacheItem; previewImg: TPictureCacheItem;
R: TRect; R: TRect;
tileSz: TSize;
procedure AddJob; procedure AddJob;
var var
@ -1120,23 +1085,33 @@ var
var var
T, L, B, R: Integer; T, L, B, R: Integer;
begin begin
T := -AWin.Y div tileSz.CY - Max(0, Sign(AWin.Y)); T := -AWin.Y div TileSize.CY - Max(0, Sign(AWin.Y));
B := T + AWin.Height div tileSz.CY + 1; B := T + AWin.Height div TileSize.CY + 1;
L := -AWin.X div tileSz.CX - Max(0, Sign(AWin.X)); L := -AWin.X div TileSize.CX - Max(0, Sign(AWin.X));
R := L + AWin.Width div tileSz.CX + 1; R := L + AWin.Width div TileSize.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 * tileSz.CY)); EraseBackground(Rect(0, 0, AWin.Width, AWin.Y + TilesVis.top * TileSize.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 * tileSz.CY, EraseBackground(Rect(
AWin.X + TilesVis.left * tileSz.CX, 0,
AWin.Y + (TilesVis.bottom + 1) * tileSz.CY)); AWin.Y + TilesVis.top * TileSize.CY,
AWin.X + TilesVis.left * TileSize.CX,
AWin.Y + (TilesVis.bottom + 1) * TileSize.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) * tileSz.CX, EraseBackground(Rect(
AWin.Y + TilesVis.top * tileSz.CY, AWin.Width, AWin.X + (TilesVis.right + 1) * TileSize.CX,
AWin.Y + (TilesVis.bottom + 1) * tileSz.CY)); AWin.Y + TilesVis.top * TileSize.CY,
if B > TilesVis.bottom then // Erase below AWin.Width,
EraseBackground(Rect(0, AWin.Y + (TilesVis.bottom + 1) * tileSz.CY, AWin.Y + (TilesVis.bottom + 1) * TileSize.CY)
AWin.Width, AWin.Height)); );
if B > TilesVis.Bottom then // Erase below
EraseBackground(Rect(
0,
AWin.Y + (TilesVis.bottom + 1) * TileSize.CY,
AWin.Width,
AWin.Height)
);
end; end;
begin begin
@ -1148,14 +1123,12 @@ 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 tileSz.CX - 1, 0); XShift := IfThen(aWin.X > 0, numTiles - aWin.X div TileSize.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
@ -1177,8 +1150,8 @@ begin
// is not valid // is not valid
begin begin
previewdrawn := False; previewdrawn := False;
py := AWin.Y + Y * tileSz.CY; py := AWin.Y + Y * TileSize.CY;
px := AWin.X + X * tileSz.CX; px := AWin.X + X * TileSize.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
@ -1410,35 +1383,33 @@ 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);
tileSz := TileSize; Y := AWin.Y + ATile.Y * TileSize.CY; // begin of Y
Y := AWin.Y + ATile.Y * tileSz.CY; // begin of Y
if Cyclic then if Cyclic then
begin begin
baseX := AWin.X + ATile.X * tileSz.CX; // begin of X baseX := AWin.X + ATile.X * TileSize.CX; // begin of X
numTiles := 1 shl AWin.Zoom; numTiles := 1 shl AWin.Zoom;
worldWidth := numTiles * tileSz.CX; worldWidth := numTiles * TileSize.CX;
// From the center to the left (western) hemisphere // From the center to the left (western) hemisphere
X := baseX; X := baseX;
while (X+tileSz.CX >= 0) do while (X + TileSize.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-tileSz.CX) <= AWin.Width) do while ((X - TileSize.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 * tileSz.CX; // begin of X X := AWin.X + ATile.X * TileSize.CX; // begin of X
DrawTile(ATile, X, Y, img); DrawTile(ATile, X, Y, img);
end; end;
end; end;

142
components/lazmapviewer/source/mvengine_mapreg.inc
View File

@ -8,7 +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://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
@ -23,18 +23,18 @@ Some providers submitted by
} }
// OpenStreetMap section // OpenStreetMap section
MapWin.MapProvider := AddMapProvider('OpenStreetMap Mapnik', ptEPSG3857, TILE_SIZE_256, 'http://%serv%.tile.openstreetmap.org/%z%/%x%/%y%.png', 0, 19, 3, @GetSvrLetter); MapWin.MapProvider := AddMapProvider('OpenStreetMap Mapnik', ptEPSG3857, '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, TILE_SIZE_256, 'https://%serv%.tile.openstreetmap.fr/hot/%z%/%x%/%y%.png', 0, 18, 3, @GetSvrLetter); AddMapProvider('OpenStreetMap.fr Hot', ptEPSG3857, 'https://%serv%.tile.openstreetmap.fr/hot/%z%/%x%/%y%.png', 0, 18, 3, @GetSvrLetter);
AddMapProvider('Open Topo Map', ptEPSG3857, TILE_SIZE_256, 'http://%serv%.tile.opentopomap.org/%z%/%x%/%y%.png', 0, 19, 3, @GetSvrLetter); AddMapProvider('Open Topo Map', ptEPSG3857, 'http://%serv%.tile.opentopomap.org/%z%/%x%/%y%.png', 0, 19, 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('OpenStreetMap.fr Cycle Map', ptEPSG3857, 'https://dev.%serv%.tile.openstreetmap.fr/cyclosm/%z%/%x%/%y%.png', 0, 18, 3, @GetSvrLetter);
AddMapProvider('OSM Refuges', ptEPSG3857, TILE_SIZE_256, 'https://maps.refuges.info/hiking/%z%/%x%/%y%.png', 0, 19, 4, nil); AddMapProvider('OSM Refuges', ptEPSG3857, '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 Standard', ptEPSG3857, 'https://%serv%.tiles.openrailwaymap.org/standard/%z%/%x%/%y%.png', 0, 19, 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 Signals', ptEPSG3857, 'https://%serv%.tiles.openrailwaymap.org/signals/%z%/%x%/%y%.png', 0, 19, 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) AddMapProvider('OpenRailwayMap MaxSpeed', ptEPSG3857, 'https://%serv%.tiles.openrailwaymap.org/maxspeed/%z%/%x%/%y%.png', 0, 19, 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
@ -43,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, TILE_SIZE_256, '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, 'https://tile.thunderforest.com/cycle/%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 OpenStreetMap Transport', ptEPSG3857, 'https://tile.thunderforest.com/transport/%z%/%x%/%y%.png?apikey=' + ThunderForest_ApiKey, 0, 19, 3, nil, nil, nil, 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 Neighbourhood', ptEPSG3857, 'https://tile.thunderforest.com/neighbourhood/%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 Atlas', ptEPSG3857, 'https://tile.thunderforest.com/atlas/%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 Pioneer', ptEPSG3857, 'https://tile.thunderforest.com/pioneer/%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 Outdoors', 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 Landscape', ptEPSG3857, 'https://tile.thunderforest.com/outdoors/%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 Mobile-Atlas', ptEPSG3857, 'https://tile.thunderforest.com/mobile-atlas/%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 Transport-Dark', ptEPSG3857, 'https://tile.thunderforest.com/transport-dark/%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); AddMapProvider('ThunderForest Spinal-Map', ptEPSG3857, '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, TILE_SIZE_256, 'http://%serv%.tile.opencyclemap.org/cycle/%z%/%x%/%y%.png', 0, 18, 3, @GetSvrLetter); // AddMapProvider('Open Cycle Map', ptEPSG3857, 'http://%serv%.tile.opencyclemap.org/cycle/%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); // AddMapProvider('OpenStreetMap Transport', ptEPSG3857, 'https://%serv%.tile.thunderforest.com/transport/%z%/%x%/%y%.png', 0, 18, 3, @GetSvrLetter);
end; end;
// Google // Google
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 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 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); AddMapProvider('Google Satellite', ptEPSG3857, '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, TILE_SIZE_256, 'http://khm%serv%.google.com/kh/v=863?x=%x%&y=%y%&z=%z%', 0, 19, 4, nil); //AddMapProvider('Google Satellite', ptEPSG3857, 'http://khm%serv%.google.com/kh/v=863?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 Terrain', ptEPSG3857, '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, 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 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 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 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 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); AddMapProvider('Google Roadmap', ptEPSG3857, '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, 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', 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 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', 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-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); 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);
// 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, 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); //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);
// Bing // Bing
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 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 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 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 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); 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);
// 2GIS (Russian labels, limited zoom range) // 2GIS (Russian labels, limited zoom range)
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... AddMapProvider('2GIS', ptEPSG3857, '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:
@ -94,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, TILE_SIZE_256, HERE1 + 'normal.day' + HERE2, 1, 19, 4, @GetSvrBase1); AddMapProvider('Here WeGo Map', ptEPSG3857, HERE1 + 'normal.day' + 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 Grey Map', ptEPSG3857, HERE1 + 'normal.day.grey' + 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 Reduced Map', ptEPSG3857, HERE1 + 'reduced.day' + 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 Transit Map', ptEPSG3857, HERE1 + 'normal.day.transit' + HERE2, 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 POI Map', ptEPSG3857, HERE1 + 'normal.day' + HERE2 + '&pois', 1, 19, 4, @GetSvrBase1);
AddMapProvider('Here WeGo Pedestrian Map', ptEPSG3857, TILE_SIZE_256, HERE1 + 'pedestrian.day' + HERE2, 1, 19, 4, @GetSvrBase1); AddMapProvider('Here WeGo Pedestrian Map', ptEPSG3857, HERE1 + 'pedestrian.day' + HERE2, 1, 19, 4, @GetSvrBase1);
AddMapProvider('Here WeGo DreamWorks Map', ptEPSG3857, TILE_SIZE_256, HERE1 + 'normal.day' + HERE2 + '&style=dreamworks', 1, 19, 4, @GetSvrBase1); AddMapProvider('Here WeGo DreamWorks Map', ptEPSG3857, 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, TILE_SIZE_256, 'https://tile.openweathermap.org/map/clouds_new/%z%/%x%/%y%.png?appid=' + OpenWeatherMap_ApiKey, 1, 19, 1, nil); AddMapProvider('OpenWeatherMap Clouds', ptEPSG3857, 'https://tile.openweathermap.org/map/clouds_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 Precipitation', ptEPSG3857, 'https://tile.openweathermap.org/map/precipitation_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 Pressure', ptEPSG3857, 'https://tile.openweathermap.org/map/pressure_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 Temperature', ptEPSG3857, 'https://tile.openweathermap.org/map/temp_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); AddMapProvider('OpenWeatherMap Wind', ptEPSG3857, '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, 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 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 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('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('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); 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);
} }
// ArcGIS // ArcGIS
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 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 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 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 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 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 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 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 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 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 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 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 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); 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);
// Apple // Apple
// 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); // 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);
// CartoDB // CartoDB
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 Light All', ptEPSG3857, 'https://cartodb-basemaps-a.global.ssl.fastly.net/light_all/%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); AddMapProvider('CartoDB Voyager', ptEPSG3857, '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, TILE_SIZE_256, 'http://maps-for-free.com/layer/relief/z%z%/row%y%/%z%_%x%-%y%.jpg', 0, 19, 4, nil); AddMapProvider('Maps For Free', ptEPSG3857, '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, TILE_SIZE_256, 'http://tile.memomaps.de/tilegen/%z%/%x%/%y%.png', 0, 19, 4, nil); AddMapProvider('Memo Maps', ptEPSG3857,'http://tile.memomaps.de/tilegen/%z%/%x%/%y%.png', 0, 19, 4, nil);
// Sigma DC Control // Sigma DC Control
//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 //AddMapProvider('Sigma DC Control', ptEPSG3857,'http://tiles1.sigma-dc-control.com/layer5/%z%/%x%/%y%.png', 0, 19, 4, nil); // -- not working
// Stamen // Stamen
AddMapProvider('Stamen Terrain', ptEPSG3857, TILE_SIZE_256, 'http://tile.stamen.com/terrain/%z%/%x%/%y%.jpg', 0, 19, 4, nil); AddMapProvider('Stamen Terrain', ptEPSG3857, 'http://tile.stamen.com/terrain/%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); AddMapProvider('Stamen Watercolor', ptEPSG3857, 'https://stamen-tiles.a.ssl.fastly.net/watercolor/%z%/%x%/%y%.jpg' , 0, 19, 4, nil);
// Via Michelin // Via Michelin
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); 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);
// GeoApify // GeoApify
//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 //AddMapProvider('Geoapify Map Tiles', ptEPSG3857, '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, TILE_SIZE_256, 'https://tiles.stadiamaps.com/tiles/outdoors/%z%/%x%/%y%.png', 0, 19, 4, nil); -- subscription required // AddMapProvider('Stadia Outdoors', ptEPSG3857, 'https://tiles.stadiamaps.com/tiles/outdoors/%z%/%x%/%y%.png', 0, 19, 4, nil); -- subscription required
// Tracestrack // Tracestrack
//AddMapProvider('Tracestrack Carto', ptEPSG3857, TILE_SIZE_256, 'https://tile.tracestrack.com/en/%z%/%x%/%y%.png,' , 0, 19, 4, nil); // -- not working //AddMapProvider('Tracestrack Carto', ptEPSG3857, 'https://tile.tracestrack.com/en/%z%/%x%/%y%.png,' , 0, 19, 4, nil); // -- not working
// Waze // Waze
AddMapProvider('Waze Background', ptEPSG3857, TILE_SIZE_256, 'https://worldtiles1.waze.com/tiles/%z%/%x%/%y%.png', 0, 19, 4, nil); AddMapProvider('Waze Background', ptEPSG3857, 'https://worldtiles1.waze.com/tiles/%z%/%x%/%y%.png', 0, 19, 4, nil);

28
components/lazmapviewer/source/mvmapprovider.pas
View File

@ -15,7 +15,7 @@ unit mvMapProvider;
interface interface
uses uses
Classes, SysUtils, Types, laz2_dom; Classes, SysUtils, laz2_dom;
type type
@ -58,20 +58,17 @@ 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; procedure AddURL(Url: String; ProjectionType: TProjectionType; NbSvr, aMinZoom, aMaxZoom: integer;
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);
@ -81,7 +78,6 @@ 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;
@ -102,7 +98,7 @@ const
implementation implementation
uses uses
TypInfo, mvTypes; TypInfo;
function GetSvrLetter(id: integer): String; function GetSvrLetter(id: integer): String;
begin begin
@ -173,14 +169,6 @@ 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;
@ -204,7 +192,6 @@ 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);
@ -297,7 +284,7 @@ begin
end; end;
procedure TMapProvider.AddURL(Url: String; ProjectionType: TProjectionType; procedure TMapProvider.AddURL(Url: String; ProjectionType: TProjectionType;
ATileSize: TSize; NbSvr, aMinZoom, aMaxZoom: integer; GetSvrStr: TGetSvrStr; NbSvr, aMinZoom, aMaxZoom: integer; GetSvrStr: TGetSvrStr;
GetXStr: TGetValStr; GetYStr: TGetValStr; GetZStr: TGetValStr); GetXStr: TGetValStr; GetYStr: TGetValStr; GetZStr: TGetValStr);
var var
nb: integer; nb: integer;
@ -306,7 +293,6 @@ 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);
@ -317,7 +303,6 @@ 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;
@ -422,9 +407,6 @@ 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;

72
components/lazmapviewer/source/mvmapviewer.pas
View File

@ -29,8 +29,8 @@ interface
uses uses
Classes, SysUtils, Controls, GraphType, Graphics, FPImage, IntfGraphics, Classes, SysUtils, Controls, GraphType, Graphics, FPImage, IntfGraphics,
Forms, ImgList, LCLVersion, fgl, Forms, ImgList, LCLVersion, fgl,
MvTypes, MvGPSObj, mvDragObj, MvCache, MvExtraData, MvEngine, MvMapProvider, mvTypes, mvGeoMath, mvGPSObj, mvDragObj, mvCache, mvExtraData,
MvDownloadEngine, MvDrawingEngine; mvEngine, mvMapProvider, mvDownloadEngine, mvDrawingEngine;
Type Type
@ -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 * Engine.TileSize.CX, W); W := Min(1 shl Zoom * TileSize.CX, W);
if Assigned(FBeforeDrawObjectsEvent) then if Assigned(FBeforeDrawObjectsEvent) then
FBeforeDrawObjectsEvent(Self); FBeforeDrawObjectsEvent(Self);
@ -2715,7 +2715,7 @@ end;
procedure TMapView.DrawTrack(const Area: TRealArea; trk: TGPSTrack); procedure TMapView.DrawTrack(const Area: TRealArea; trk: TGPSTrack);
var var
I, L, T, WS: Integer; I, L, T, WSx, WSy: Integer;
ClipRect: TRect; ClipRect: TRect;
iPt1, iPt2, iPt3, iPt4: TPoint; iPt1, iPt2, iPt3, iPt4: TPoint;
ToEast, EndSegm, ConnSegm: Boolean; ToEast, EndSegm, ConnSegm: Boolean;
@ -2768,9 +2768,10 @@ 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) * Engine.TileSize.CX; WSx := mvGeoMath.ZoomFactor(Zoom) * TileSize.CX;
ClipRect := Rect(L, T, Min(Engine.MapLeft + WS, ClientWidth), WSy := mvGeoMath.ZoomFactor(Zoom) * TileSize.CY;
Min(Engine.MapTop + WS, ClientHeight)); ClipRect := Rect(L, T, Min(Engine.MapLeft + WSx, ClientWidth),
Min(Engine.MapTop + WSy, ClientHeight));
end; end;
pt1 := trk.Points[0].RealPoint; pt1 := trk.Points[0].RealPoint;
@ -2836,7 +2837,7 @@ begin
if Cyclic then if Cyclic then
begin begin
WS := ZoomFactor(Zoom) * Engine.TileSize.CX; // To do: Fix case when tiles are not square WS := mvGeoMath.ZoomFactor(Zoom) * TileSize.CX;
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,14 +3071,11 @@ 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 + tileSize.CX, Y + tileSize.CY), R, TileImg) DrawingEngine.DrawScaledCacheItem(Rect(X, Y, X + TileSize.CX, Y + TileSize.CY), R, TileImg)
else else
DrawingEngine.FillPixels(X, Y, X + tileSize.CY, Y + tileSize.CY, InactiveColor); DrawingEngine.FillPixels(X, Y, X + TileSize.CX, Y + TileSize.CY, InactiveColor);
if FDebugTiles then if FDebugTiles then
DoDrawTileInfo(TileID, X, Y); DoDrawTileInfo(TileID, X, Y);
@ -3086,32 +3084,25 @@ 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
begin DrawingEngine.FillPixels(X, Y, X + TileSize.CX, Y + TileSize.CY, InactiveColor);
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 + tileSize.CY); DrawingEngine.Line(X, Y, X, Y + TileSize.CY);
DrawingEngine.Line(X, Y, X + tileSize.CX, Y); DrawingEngine.Line(X, Y, X + TileSize.CX, Y);
DrawingEngine.Line(X + tileSize.CX, Y, X + tileSize.CX, Y + tileSize.CY); DrawingEngine.Line(X + TileSize.CX, Y, X + TileSize.CX, Y + TileSize.CY);
DrawingEngine.Line(X, Y + tileSize.CY, X + tileSize.CX, Y + tileSize.CY); 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);
@ -3258,7 +3249,7 @@ var
WorldSize: Int64; WorldSize: Int64;
begin begin
Result := APoint; Result := APoint;
WorldSize := ZoomFactor(Zoom) * Engine.TileSize.CX; WorldSize := mvGeoMath.ZoomFactor(Zoom) * TileSize.CX;
if Eastwards then if Eastwards then
begin begin
while Result.X < ARefX do while Result.X < ARefX do
@ -3287,7 +3278,7 @@ begin
end end
else else
begin begin
WorldSize := ZoomFactor(Zoom) * Engine.TileSize.CX; WorldSize := mvGeoMath.ZoomFactor(Zoom) * 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;
@ -3457,7 +3448,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) * Engine.TileSize.CX; mapWidth := mvGeoMath.ZoomFactor(Engine.Zoom) * TileSize.CX;
if Width >= mapWidth then if Width >= mapWidth then
begin begin
Result.TopLeft.Lon := -180; Result.TopLeft.Lon := -180;
@ -3737,23 +3728,20 @@ 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);
tileSize := V.Engine.TileSize; X := -PtTL.X div TileSize.CX;
X := -PtTL.X div tileSize.CX; Y := -PtTL.Y div TileSize.CY;
Y := -PtTL.Y div tileSize.CY; Pt0 := Point(V.Engine.MapLeft + X * TileSize.CX, V.Engine.MapTop + Y * TileSize.CY);
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 tileSize.CY; H := Y + (PtBR.Y - PtTL.Y) div TileSize.CY;
while Y <= H do while Y <= H do
begin begin
X := -PtTL.X div tileSize.CX; X := -PtTL.X div TileSize.CX;
W := X + (PtBR.X - PtTL.X) div tileSize.CX; W := X + (PtBR.X - PtTL.X) div TileSize.CY;
while X <= W do while X <= W do
begin begin
Z := V.Zoom; Z := V.Zoom;
@ -3761,13 +3749,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 + (tileSize.CX - extent.CX) div 2, V.DrawingEngine.TextOut(Pt.X + (TileSize.CX - extent.CX) div 2,
Pt.Y + (tileSize.CY - extent.CY) div 2, S); Pt.Y + (TileSize.CY - extent.CY) div 2, S);
Inc(Pt.X, tileSize.CX); Inc(Pt.X, TileSize.CX);
Inc(X); Inc(X);
end; end;
Pt.X := Pt0.X; Pt.X := Pt0.X;
Inc(Pt.Y, tileSize.CY); Inc(Pt.Y, TileSize.CY);
Inc(Y); Inc(Y);
end; end;
end; end;

7
components/lazmapviewer/source/mvtypes.pas
View File

@ -15,13 +15,14 @@ unit mvTypes;
interface interface
uses uses
Classes, SysUtils, Math, Types; Classes, SysUtils, Types, Math;
const const
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); var
TileSize: TSize = (CX:256; CY:256);
Type Type
{ TArea } { TArea }