You've already forked lazarus-ccr
LazMapViewer: Add import/export of map providers to/from xml file.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6839 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -106,13 +106,6 @@ Type
|
||||
procedure TileDownloaded(Data: PtrInt);
|
||||
Procedure RegisterProviders;
|
||||
Procedure DrawTile(const TileId: TTileId; X,Y: integer; TileImg: TLazIntfImage);
|
||||
|
||||
function GetLetterSvr(id: integer): String;
|
||||
function GetYahooSvr(id: integer): String;
|
||||
function GetYahooY(const Tile: TTileId): string;
|
||||
function GetYahooZ(const Tile: TTileId): string;
|
||||
function GetQuadKey(const Tile: TTileId): string;
|
||||
|
||||
Procedure DoDrag(Sender: TDragObj);
|
||||
public
|
||||
constructor Create(aOwner: TComponent); override;
|
||||
@ -123,13 +116,16 @@ Type
|
||||
GetXStr: TGetValStr = nil; GetYStr: TGetValStr = nil;
|
||||
GetZStr: TGetValStr = nil): TMapProvider;
|
||||
procedure CancelCurrentDrawing;
|
||||
procedure ClearMapProviders;
|
||||
procedure GetMapProviders(AList: TStrings);
|
||||
function LonLatToScreen(aPt: TRealPoint): TPoint;
|
||||
function LonLatToWorldScreen(aPt: TRealPoint): TPoint;
|
||||
function ReadProvidersFromXML(AFileName: String; out AMsg: String): Boolean;
|
||||
procedure Redraw;
|
||||
function ScreenToLonLat(aPt: TPoint): TRealPoint;
|
||||
procedure SetSize(aWidth, aHeight: integer);
|
||||
function WorldScreenToLonLat(aPt: TPoint): TRealPoint;
|
||||
procedure WriteProvidersToXML(AFileName: String);
|
||||
|
||||
procedure DblClick(Sender: TObject);
|
||||
procedure MouseDown(Sender: TObject; Button: TMouseButton;
|
||||
@ -169,7 +165,7 @@ Type
|
||||
implementation
|
||||
|
||||
uses
|
||||
Math, Forms,
|
||||
Math, Forms, laz2_xmlread, laz2_xmlwrite, laz2_dom,
|
||||
mvJobs, mvGpsObj;
|
||||
|
||||
type
|
||||
@ -328,12 +324,9 @@ begin
|
||||
end;
|
||||
|
||||
destructor TMapViewerEngine.Destroy;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
ClearMapProviders;
|
||||
FreeAndNil(DragObj);
|
||||
for i:=0 to lstProvider.Count-1 do
|
||||
TObject(lstProvider.Objects[i]).Free;
|
||||
FreeAndNil(lstProvider);
|
||||
FreeAndNil(Cache);
|
||||
FreeAndNil(Queue);
|
||||
@ -397,6 +390,15 @@ begin
|
||||
Queue.WaitForTerminate(Jobs);
|
||||
end;
|
||||
|
||||
procedure TMapViewerEngine.ClearMapProviders;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=0 to lstProvider.Count-1 do
|
||||
TObject(lstProvider.Objects[i]).Free;
|
||||
lstProvider.Clear;
|
||||
end;
|
||||
|
||||
procedure TMapViewerEngine.ConstraintZoom(var aWin: TMapWindow);
|
||||
var
|
||||
zMin, zMax: integer;
|
||||
@ -505,37 +507,11 @@ begin
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function TMapViewerEngine.GetLetterSvr(id: integer): String;
|
||||
begin
|
||||
Result := Char(Ord('a') + id);
|
||||
end;
|
||||
|
||||
procedure TMapViewerEngine.GetMapProviders(AList: TStrings);
|
||||
begin
|
||||
AList.Assign(lstProvider);
|
||||
end;
|
||||
|
||||
function TMapViewerEngine.GetQuadKey(const Tile : TTileId): string;
|
||||
var
|
||||
i, d, m: Longword;
|
||||
begin
|
||||
{
|
||||
Bing Maps Tile System
|
||||
http://msdn.microsoft.com/en-us/library/bb259689.aspx
|
||||
}
|
||||
Result := '';
|
||||
for i := Tile.Z downto 1 do
|
||||
begin
|
||||
d := 0;
|
||||
m := 1 shl (i - 1);
|
||||
if (Tile.x and m) <> 0 then
|
||||
Inc(d, 1);
|
||||
if (Tile.y and m) <> 0 then
|
||||
Inc(d, 2);
|
||||
Result := Result + IntToStr(d);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMapViewerEngine.GetTileName(const Id: TTileId): String;
|
||||
begin
|
||||
Result := IntToStr(Id.X) + '.' + IntToStr(Id.Y) + '.' + IntToStr(Id.Z);
|
||||
@ -551,21 +527,6 @@ begin
|
||||
Result := MapWin.Width;
|
||||
end;
|
||||
|
||||
function TMapViewerEngine.GetYahooSvr(id: integer): String;
|
||||
Begin
|
||||
Result := IntToStr(id + 1);
|
||||
end;
|
||||
|
||||
function TMapViewerEngine.GetYahooY(const Tile : TTileId): string;
|
||||
begin
|
||||
Result := IntToStr( -(Tile.Y - (1 shl Tile.Z) div 2) - 1);
|
||||
end;
|
||||
|
||||
function TMapViewerEngine.GetYahooZ(const Tile : TTileId): string;
|
||||
Begin
|
||||
result := IntToStr(Tile.Z + 1);
|
||||
end;
|
||||
|
||||
function TMapViewerEngine.GetZoom: integer;
|
||||
begin
|
||||
Result := MapWin.Zoom;
|
||||
@ -727,6 +688,114 @@ Begin
|
||||
SetCenter(nCenter);
|
||||
end;
|
||||
|
||||
function TMapViewerEngine.ReadProvidersFromXML(AFileName: String;
|
||||
out AMsg: String): Boolean;
|
||||
|
||||
function GetSvrStr(AName: String): TGetSvrStr;
|
||||
var
|
||||
lcName: String;
|
||||
begin
|
||||
lcName := LowerCase(AName);
|
||||
case lcName of
|
||||
'letter': Result := @GetLetterSvr;
|
||||
'yahoo': Result := @GetYahooSvr;
|
||||
else Result := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetValStr(AName: String): TGetValStr;
|
||||
var
|
||||
lcName: String;
|
||||
begin
|
||||
lcName := Lowercase(AName);
|
||||
case lcName of
|
||||
'quadkey': Result := @GetQuadKey;
|
||||
'yahooy': Result := @GetYahooY;
|
||||
'yahooz': Result := @GetYahooZ;
|
||||
else Result := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetAttrValue(ANode: TDOMNode; AttrName: String): String;
|
||||
var
|
||||
node: TDOMNode;
|
||||
begin
|
||||
Result := '';
|
||||
if ANode.HasAttributes then begin
|
||||
node := ANode.Attributes.GetNamedItem(AttrName);
|
||||
if Assigned(node) then Result := node.NodeValue;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
stream: TFileStream;
|
||||
doc: TXMLDocument = nil;
|
||||
node, layerNode: TDOMNode;
|
||||
attr: TDOMNamedNodeMap;
|
||||
providerName: String;
|
||||
url: String;
|
||||
minZoom: Integer;
|
||||
maxZoom: Integer;
|
||||
svrCount: Integer;
|
||||
s: String;
|
||||
svrProc: String;
|
||||
xProc: String;
|
||||
yProc: String;
|
||||
zProc: String;
|
||||
first: Boolean;
|
||||
begin
|
||||
Result := false;
|
||||
AMsg := '';
|
||||
stream := TFileStream.Create(AFileName, fmOpenread or fmShareDenyWrite);
|
||||
try
|
||||
ReadXMLFile(doc, stream, [xrfAllowSpecialCharsInAttributeValue, xrfAllowLowerThanInAttributeValue]);
|
||||
node := doc.FindNode('map_providers');
|
||||
if node = nil then begin
|
||||
AMsg := 'No map providers in file.';
|
||||
exit;
|
||||
end;
|
||||
|
||||
first := true;
|
||||
node := node.FirstChild;
|
||||
while node <> nil do begin
|
||||
providerName := GetAttrValue(node, 'name');
|
||||
layerNode := node.FirstChild;
|
||||
while layerNode <> nil do begin
|
||||
url := GetAttrValue(layerNode, 'url');
|
||||
if url = '' then
|
||||
continue;
|
||||
s := GetAttrValue(layerNode, 'minZom');
|
||||
if s = '' then minZoom := 0
|
||||
else minZoom := StrToInt(s);
|
||||
s := GetAttrValue(layerNode, 'maxZoom');
|
||||
if s = '' then maxzoom := 9
|
||||
else maxZoom := StrToInt(s);
|
||||
s := GetAttrValue(layerNode, 'serverCount');
|
||||
if s = '' then svrCount := 1
|
||||
else svrCount := StrToInt(s);
|
||||
svrProc := GetAttrValue(layerNode, 'serverProc');
|
||||
xProc := GetAttrValue(layerNode, 'xProc');
|
||||
yProc := GetAttrValue(layerNode, 'yProc');
|
||||
zProc := GetAttrValue(layerNode, 'zProc');
|
||||
layerNode := layerNode.NextSibling;
|
||||
end;
|
||||
if first then begin
|
||||
ClearMapProviders;
|
||||
first := false;
|
||||
end;
|
||||
AddMapProvider(providerName,
|
||||
url, minZoom, maxZoom, svrCount,
|
||||
GetSvrStr(svrProc), GetValStr(xProc), GetValStr(yProc), GetValStr(zProc)
|
||||
);
|
||||
node := node.NextSibling;
|
||||
end;
|
||||
Result := true;
|
||||
finally
|
||||
stream.Free;
|
||||
doc.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMapViewerEngine.Redraw;
|
||||
begin
|
||||
Redraw(MapWin);
|
||||
@ -970,6 +1039,27 @@ begin
|
||||
Result := ScreenToLonLat(aPt);
|
||||
end;
|
||||
|
||||
procedure TMapViewerEngine.WriteProvidersToXML(AFileName: String);
|
||||
var
|
||||
doc: TXMLDocument;
|
||||
root: TDOMNode;
|
||||
i: Integer;
|
||||
prov: TMapProvider;
|
||||
begin
|
||||
doc := TXMLDocument.Create;
|
||||
try
|
||||
root := doc.CreateElement('map_providers');
|
||||
doc.AppendChild(root);
|
||||
for i := 0 to lstProvider.Count - 1 do begin
|
||||
prov := TMapProvider(lstProvider.Objects[i]);
|
||||
prov.ToXML(doc, root);
|
||||
end;
|
||||
WriteXMLFile(doc, AFileName);
|
||||
finally
|
||||
doc.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMapViewerEngine.ZoomOnArea(const aArea: TRealArea);
|
||||
var
|
||||
tmpWin: TMapWindow;
|
||||
|
||||
@ -22,22 +22,23 @@ unit mvMapProvider;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
Classes, SysUtils, laz2_xmlwrite, laz2_dom;
|
||||
|
||||
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;
|
||||
TGetSvrStr = function (id: integer): string;
|
||||
TGetValStr = function (const Tile: TTileId): String;
|
||||
|
||||
{ TMapProvider }
|
||||
|
||||
TMapProvider = Class
|
||||
TMapProvider = class
|
||||
private
|
||||
FLayer: integer;
|
||||
idServer: Array of Integer;
|
||||
@ -60,15 +61,63 @@ type
|
||||
GetSvrStr: TGetSvrStr; GetXStr: TGetValStr; GetYStr: TGetValStr;
|
||||
GetZStr: TGetValStr);
|
||||
procedure GetZoomInfos(out AZoomMin, AZoomMax: integer);
|
||||
Function GetUrlForTile(id: TTileId): String;
|
||||
function GetUrlForTile(id: TTileId): String;
|
||||
procedure ToXML(ADoc: TXMLDocument; AParentNode: TDOMNode);
|
||||
property Name: String read FName;
|
||||
property LayerCount: integer read GetLayerCount;
|
||||
property Layer: integer read FLayer write SetLayer;
|
||||
end;
|
||||
|
||||
|
||||
function GetLetterSvr(id: integer): String;
|
||||
function GetYahooSvr(id: integer): String;
|
||||
function GetYahooY(const Tile: TTileId): string;
|
||||
function GetYahooZ(const Tile: TTileId): string;
|
||||
function GetQuadKey(const Tile: TTileId): string;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
function GetLetterSvr(id: integer): String;
|
||||
begin
|
||||
Result := Char(Ord('a') + id);
|
||||
end;
|
||||
|
||||
function GetQuadKey(const Tile: TTileId): string;
|
||||
var
|
||||
i, d, m: Longword;
|
||||
begin
|
||||
{ Bing Maps Tile System
|
||||
http://msdn.microsoft.com/en-us/library/bb259689.aspx }
|
||||
Result := '';
|
||||
for i := Tile.Z downto 1 do
|
||||
begin
|
||||
d := 0;
|
||||
m := 1 shl (i - 1);
|
||||
if (Tile.x and m) <> 0 then
|
||||
Inc(d, 1);
|
||||
if (Tile.y and m) <> 0 then
|
||||
Inc(d, 2);
|
||||
Result := Result + IntToStr(d);
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetYahooSvr(id: integer): String;
|
||||
Begin
|
||||
Result := IntToStr(id + 1);
|
||||
end;
|
||||
|
||||
function GetYahooY(const Tile : TTileId): string;
|
||||
begin
|
||||
Result := IntToStr( -(Tile.Y - (1 shl Tile.Z) div 2) - 1);
|
||||
end;
|
||||
|
||||
function GetYahooZ(const Tile : TTileId): string;
|
||||
Begin
|
||||
result := IntToStr(Tile.Z + 1);
|
||||
end;
|
||||
|
||||
|
||||
{ TMapProvider }
|
||||
|
||||
function TMapProvider.getLayerCount: integer;
|
||||
@ -172,5 +221,48 @@ begin
|
||||
Result := StringReplace(Result, '%z%', ZVal, [rfreplaceall]);
|
||||
end;
|
||||
|
||||
procedure TMapProvider.ToXML(ADoc: TXMLDocument; AParentNode: TDOMNode);
|
||||
var
|
||||
i: Integer;
|
||||
node: TDOMElement;
|
||||
layerNode: TDOMElement;
|
||||
s: String;
|
||||
begin
|
||||
node := ADoc.CreateElement('map_provider');
|
||||
node.SetAttribute('name', FName);
|
||||
AParentNode.AppendChild(node);
|
||||
for i:=0 to LayerCount-1 do begin
|
||||
layerNode := ADoc.CreateElement('layer');
|
||||
node.AppendChild(layernode);
|
||||
layerNode.SetAttribute('url', FUrl[i]);
|
||||
layerNode.SetAttribute('minZoom', IntToStr(FMinZoom[i]));
|
||||
layerNode.SetAttribute('maxZoom', IntToStr(FMaxZoom[i]));
|
||||
layerNode.SetAttribute('serverCount', IntToStr(FNbSvr[i]));
|
||||
|
||||
if FGetSvrStr[i] = @getLetterSvr then s := 'Letter'
|
||||
else if FGetSvrStr[i] = @GetYahooSvr then s := 'Yahoo'
|
||||
else if FGetSvrstr[i] <> nil then s := 'unknown'
|
||||
else s := '';
|
||||
if s <> '' then layerNode.SetAttribute('serverProc', s);
|
||||
|
||||
if FGetXStr[i] = @GetQuadKey then s := 'QuadKey'
|
||||
else if FGetXStr[i] <> nil then s := '(unknown)'
|
||||
else s := '';
|
||||
if s <> '' then layerNode.SetAttribute('xProc', s);
|
||||
|
||||
if FGetYStr[i] = @GetQuadKey then s := 'QuadKey'
|
||||
else if FGetYStr[i] = @GetYahooY then s := 'YahooY'
|
||||
else if FGetYStr[i] <> nil then s := '(unknown)'
|
||||
else s := '';
|
||||
if s <> '' then layerNode.SetAttribute('yProc', s);
|
||||
|
||||
if FGetZStr[i] = @GetQuadKey then s := 'QuadKey'
|
||||
else if FGetZStr[i] = @GetYahooZ then s := 'YahooZ'
|
||||
else if FGetZStr[i] <> nil then s := '(unknown)'
|
||||
else s := '';
|
||||
if s <> '' then layerNode.SetAttribute('zProc', s);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Reference in New Issue
Block a user