70aa57d3bb
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6809 8e941d3f-bd1b-0410-a28a-d453659cc2b4
177 lines
4.5 KiB
ObjectPascal
177 lines
4.5 KiB
ObjectPascal
{
|
|
(c) 2014 ti_dic
|
|
|
|
This library is free software; you can redistribute it and/or modify it
|
|
under the terms of the GNU Library General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or (at your
|
|
option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful, but WITHOUT
|
|
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
|
|
for more details.
|
|
|
|
You should have received a copy of the GNU Library General Public License
|
|
along with this library; if not, write to the Free Software Foundation,
|
|
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
|
}
|
|
unit mvMapProvider;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils;
|
|
|
|
type
|
|
{ TTileId }
|
|
TTileId = record
|
|
X, Y: int64;
|
|
Z: integer;
|
|
end;
|
|
|
|
|
|
TGetSvrStr = function (id: integer): string of object;
|
|
TGetValStr = function (const Tile: TTileId): String of object;
|
|
|
|
{ TMapProvider }
|
|
|
|
TMapProvider = Class
|
|
private
|
|
FLayer: integer;
|
|
idServer: Array of Integer;
|
|
FName: String;
|
|
FUrl: Array of string;
|
|
FNbSvr: Array of integer;
|
|
FGetSvrStr: Array of TGetSvrStr;
|
|
FGetXStr: Array of TGetValStr;
|
|
FGetYStr: Array of TGetValStr;
|
|
FGetZStr: Array of TGetValStr;
|
|
FMinZoom: Array of integer;
|
|
FMaxZoom: Array of integer;
|
|
function GetLayerCount: integer;
|
|
procedure SetLayer(AValue: integer);
|
|
|
|
public
|
|
constructor Create(AName: String);
|
|
destructor Destroy; override;
|
|
procedure AddURL(Url: String; NbSvr, aMinZoom, aMaxZoom: integer;
|
|
GetSvrStr: TGetSvrStr; GetXStr: TGetValStr; GetYStr: TGetValStr;
|
|
GetZStr: TGetValStr);
|
|
procedure GetZoomInfos(out AZoomMin, AZoomMax: integer);
|
|
Function GetUrlForTile(id: TTileId): String;
|
|
property Name: String read FName;
|
|
property LayerCount: integer read GetLayerCount;
|
|
property Layer: integer read FLayer write SetLayer;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
{ TMapProvider }
|
|
|
|
function TMapProvider.getLayerCount: integer;
|
|
begin
|
|
Result:=length(FUrl);
|
|
end;
|
|
|
|
procedure TMapProvider.SetLayer(AValue: integer);
|
|
begin
|
|
if FLayer = AValue then Exit;
|
|
if (aValue < Low(FUrl)) and (aValue > High(FUrl)) then
|
|
Begin
|
|
Raise Exception.Create('bad Layer');
|
|
end;
|
|
FLayer:=AValue;
|
|
end;
|
|
|
|
constructor TMapProvider.Create(aName: String);
|
|
begin
|
|
FName := aName;
|
|
end;
|
|
|
|
destructor TMapProvider.Destroy;
|
|
begin
|
|
Finalize(idServer);
|
|
Finalize(FName);
|
|
Finalize(FUrl);
|
|
Finalize(FNbSvr);
|
|
Finalize(FGetSvrStr);
|
|
Finalize(FGetXStr);
|
|
Finalize(FGetYStr);
|
|
Finalize(FGetZStr);
|
|
Finalize(FMinZoom);
|
|
Finalize(FMaxZoom);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TMapProvider.AddURL(Url: String; NbSvr: integer;
|
|
aMinZoom: integer; aMaxZoom: integer; GetSvrStr: TGetSvrStr;
|
|
GetXStr: TGetValStr; GetYStr: TGetValStr; GetZStr: TGetValStr);
|
|
var
|
|
nb: integer;
|
|
begin
|
|
nb := Length(FUrl)+1;
|
|
SetLength(IdServer, nb);
|
|
SetLength(FUrl, nb);
|
|
SetLength(FNbSvr, nb);
|
|
SetLength(FGetSvrStr, nb);
|
|
SetLength(FGetXStr, nb);
|
|
SetLength(FGetYStr, nb);
|
|
SetLength(FGetZStr, nb);
|
|
SetLength(FMinZoom, nb);
|
|
SetLength(FMaxZoom, nb);
|
|
nb := High(FUrl);
|
|
FUrl[nb] := Url;
|
|
FNbSvr[nb] := NbSvr;
|
|
FMinZoom[nb] := aMinZoom;
|
|
FMaxZoom[nb] := aMaxZoom;
|
|
FGetSvrStr[nb] := GetSvrStr;
|
|
FGetXStr[nb] := GetXStr;
|
|
FGetYStr[nb] := GetYStr;
|
|
FGetZStr[nb] := GetZStr;
|
|
FLayer := Low(FUrl);
|
|
end;
|
|
|
|
procedure TMapProvider.GetZoomInfos(out AZoomMin, AZoomMax: integer);
|
|
begin
|
|
AZoomMin := FMinZoom[layer];
|
|
AZoomMax := FMaxZoom[layer];
|
|
end;
|
|
|
|
function TMapProvider.GetUrlForTile(id: TTileId): String;
|
|
var
|
|
i: integer;
|
|
XVal, yVal, zVal, SvrVal: String;
|
|
idsvr: integer;
|
|
begin
|
|
Result := '';
|
|
i := layer;
|
|
if (i > High(idServer)) or (i < Low(idServer)) or (FNbSvr[i] = 0) then
|
|
exit;
|
|
|
|
idsvr := idServer[i] mod FNbSvr[i];
|
|
idServer[i] += 1;
|
|
|
|
SvrVal := IntToStr(idsvr);
|
|
XVal := IntToStr(id.X);
|
|
YVal := IntToStr(id.Y);
|
|
ZVal := IntToStr(id.Z);
|
|
if Assigned(FGetSvrStr[i]) then
|
|
SvrVal := FGetSvrStr[i](idsvr);
|
|
if Assigned(FGetXStr[i]) then
|
|
XVal := FGetXStr[i](id);
|
|
if Assigned(FGetYStr[i]) then
|
|
YVal := FGetYStr[i](id);
|
|
if Assigned(FGetZStr[i]) then
|
|
ZVal := FGetZStr[i](id);
|
|
Result := StringReplace(FUrl[i], '%serv%', SvrVal, [rfreplaceall]);
|
|
Result := StringReplace(Result, '%x%', XVal, [rfreplaceall]);
|
|
Result := StringReplace(Result, '%y%', YVal, [rfreplaceall]);
|
|
Result := StringReplace(Result, '%z%', ZVal, [rfreplaceall]);
|
|
end;
|
|
|
|
end.
|
|
|