diff --git a/components/lazmapviewer/example/main.lfm b/components/lazmapviewer/example/main.lfm index 5113f9b00..7837a2551 100644 --- a/components/lazmapviewer/example/main.lfm +++ b/components/lazmapviewer/example/main.lfm @@ -12,28 +12,27 @@ object MainForm: TMainForm ShowHint = True LCLVersion = '2.1.0.0' object ControlPanel: TPanel - Left = 632 + Left = 592 Height = 545 Top = 0 - Width = 237 + Width = 277 Align = alRight ClientHeight = 545 - ClientWidth = 237 + ClientWidth = 277 TabOrder = 1 object CbProviders: TComboBox AnchorSideLeft.Control = LblProviders AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = ControlPanel - AnchorSideRight.Control = ControlPanel - AnchorSideRight.Side = asrBottom + AnchorSideRight.Control = BtnLoadMapProviders Left = 69 Height = 23 Top = 9 - Width = 159 + Width = 145 Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 8 BorderSpacing.Top = 8 - BorderSpacing.Right = 8 + BorderSpacing.Right = 4 DropDownCount = 24 ItemHeight = 15 OnChange = CbProvidersChange @@ -89,7 +88,7 @@ object MainForm: TMainForm Left = 69 Height = 40 Top = 59 - Width = 167 + Width = 207 Max = 17 Min = 1 OnChange = ZoomTrackBarChange @@ -114,18 +113,18 @@ object MainForm: TMainForm AnchorSideLeft.Control = LblProviders AnchorSideTop.Control = ZoomTrackBar AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = CbProviders + AnchorSideRight.Control = BtnSaveMapProviders AnchorSideRight.Side = asrBottom Left = 9 Height = 66 Top = 107 - Width = 219 + Width = 259 Anchors = [akTop, akLeft, akRight] AutoSize = True BorderSpacing.Top = 8 Caption = 'Mouse position' ClientHeight = 46 - ClientWidth = 215 + ClientWidth = 255 TabOrder = 4 object LblPositionLongitude: TLabel AnchorSideLeft.Control = CbMouseCoords @@ -158,7 +157,7 @@ object MainForm: TMainForm AnchorSideTop.Control = CbMouseCoords AnchorSideRight.Control = CbMouseCoords AnchorSideRight.Side = asrBottom - Left = 165 + Left = 205 Height = 15 Top = 4 Width = 34 @@ -175,7 +174,7 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = CbMouseCoords AnchorSideRight.Side = asrBottom - Left = 165 + Left = 205 Height = 15 Top = 23 Width = 34 @@ -192,18 +191,18 @@ object MainForm: TMainForm AnchorSideLeft.Control = LblProviders AnchorSideTop.Control = CbMouseCoords AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = CbProviders + AnchorSideRight.Control = CbMouseCoords AnchorSideRight.Side = asrBottom Left = 9 Height = 66 Top = 185 - Width = 219 + Width = 259 Anchors = [akTop, akLeft, akRight] AutoSize = True BorderSpacing.Top = 12 Caption = 'Center' ClientHeight = 46 - ClientWidth = 215 + ClientWidth = 255 TabOrder = 5 object LblCenterLongitude: TLabel AnchorSideLeft.Control = GbCenterCoords @@ -236,7 +235,7 @@ object MainForm: TMainForm AnchorSideTop.Control = GbCenterCoords AnchorSideRight.Control = GbCenterCoords AnchorSideRight.Side = asrBottom - Left = 165 + Left = 205 Height = 15 Top = 4 Width = 34 @@ -253,7 +252,7 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideRight.Control = GbCenterCoords AnchorSideRight.Side = asrBottom - Left = 165 + Left = 205 Height = 15 Top = 23 Width = 34 @@ -274,7 +273,7 @@ object MainForm: TMainForm Left = 9 Height = 23 Top = 264 - Width = 150 + Width = 190 Anchors = [akTop, akLeft, akRight] BorderSpacing.Right = 8 BorderSpacing.Bottom = 4 @@ -286,9 +285,9 @@ object MainForm: TMainForm object BtnSearch: TButton AnchorSideTop.Control = GbCenterCoords AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = CbProviders + AnchorSideRight.Control = GbCenterCoords AnchorSideRight.Side = asrBottom - Left = 167 + Left = 207 Height = 25 Top = 263 Width = 61 @@ -307,7 +306,7 @@ object MainForm: TMainForm Left = 9 Height = 21 Top = 318 - Width = 156 + Width = 196 Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 4 BorderSpacing.Right = 8 @@ -337,7 +336,7 @@ object MainForm: TMainForm AnchorSideTop.Side = asrCenter AnchorSideRight.Control = BtnSearch AnchorSideRight.Side = asrBottom - Left = 173 + Left = 213 Height = 25 Top = 316 Width = 55 @@ -356,7 +355,7 @@ object MainForm: TMainForm Left = 8 Height = 52 Top = 380 - Width = 220 + Width = 260 Anchors = [akTop, akLeft, akRight] AutoSize = False BorderSpacing.Top = 8 @@ -386,20 +385,120 @@ object MainForm: TMainForm Left = 8 Height = 80 Top = 432 - Width = 220 + Width = 260 Anchors = [akTop, akLeft, akRight] AutoSize = False Caption = 'GPSPointInfo' ParentColor = False WordWrap = True end + object BtnLoadMapProviders: TSpeedButton + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CbProviders + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = BtnSaveMapProviders + Left = 218 + Height = 22 + Top = 9 + Width = 23 + Anchors = [akTop, akRight] + BorderSpacing.Right = 4 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000003591 + DBFA439FDDFA439FDDFA429FDDFA429EDDFA419EDCFA419EDCFA419EDCFA419E + DCFA419EDCFA419EDCFA419EDCFA3792DAFB3080DF100000000000000000429C + DEF76EC7EBFF6DC7EAFF6BC6EAFF6AC5E9FF68C4E9FF67C3E8FF65C2E8FF64C1 + E7FF63C0E7FF61BFE6FF60BEE5FF51AFE3FE308CD6450000000000000000409A + DDF47CD0F1FF7BD0F0FF7ACFEFFF79CEEFFF77CDEEFF76CCEEFF74CBEDFF73CA + EDFF71C9ECFF70C8ECFF6EC7EBFF6AC3E9FF3993DB8E00000000000000003E99 + DCEC7ECEF1FF8AD9F6FF89D8F5FF87D7F4FF86D6F4FF84D5F3FF83D5F3FF81D4 + F2FF80D3F2FF7ED2F1FF7DD1F1FF7BD0F0FF439ADEB40000000000000000409B + DDE470C1EDFF99E2FBFF97E2FBFF96E1FAFF94E0F9FF93DFF9FF91DEF8FF90DD + F8FF8EDCF7FF8DDBF7FF8CDAF6FF8AD9F6FF4EA4E2CD00000000000000004AA5 + E0DF61B3E8FFA3E9FFFFA3E9FFFFA3E9FFFFA3E9FFFFA2E8FEFFA0E7FEFF9FE6 + FDFF9DE5FDFF9CE4FCFF9AE3FCFF99E2FBFF5FB3E9E33080DF100000000051A8 + E2DF5EB2E8FFA3E9FFFFA3E9FFFFA3E9FFFFA3E9FFFFA3E9FFFFA3E9FFFFA3E9 + FFFFA3E9FFFFA3E9FFFFA3E9FFFFA3E9FFFF84CFF5FB348CDA450000000058AD + E5DF60B3E8FF61B3E9FF61B3E9FF60B2E9FF60B2E8FF60B2E8FF5FB1E8FF5FB1 + E8FF5EB1E8FF5EB1E8FF5EB1E7FF59ADE7FB55A9E5E33B94DC85000000005FB0 + E8DF9DE4FBFF9AE3FAFF97E1F9FF94DFF8FF91DDF7FF8EDBF5FF8BD9F4FF88D8 + F3FF85D6F2FF82D4F1FF7FD2F0FF4FA7E1DF00000000000000000000000061B1 + E8DFA6EAFFFFA6EAFFFFA6EAFFFFA3E8FEFF7AC6F1ED59ACE6DF58AAE5DF57AA + E5DF56AAE5DF53A9E4DF53A8E4DF3C94DCE20000000000000000000000004096 + DEE25DAEE7DF5DAEE7DF5DAEE7DF57A9E6DF4399DF6E00000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000 + } + OnClick = BtnLoadMapProvidersClick + end + object BtnSaveMapProviders: TSpeedButton + AnchorSideLeft.Control = BtnLoadMapProviders + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CbProviders + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = ControlPanel + AnchorSideRight.Side = asrBottom + Left = 245 + Height = 22 + Top = 9 + Width = 23 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000A4653455A465 + 34FFA46534FFB6BDBAFFB6BDBAFFB6BDBAFFB6BDBAFFB6BDBAFFB6BDBAFFB6BD + BAFFA46534FFA46534FFA46534FFA46534FFA46534FF00000000A46534FFA465 + 34FFA46534FFB6BDBAFFA46534FFB6BDBAFFB6BDBAFFB6BDBAFFB6BDBAFFB6BD + BAFFA46534FFA46534FFA46534FFA46534FFA46534FF00000000A46534FFA465 + 34FFA46534FFB6BDBAFFA46534FFB6BDBAFFB6BDBAFFB6BDBAFFB6BDBAFFB6BD + BAFFA46534FFA46534FFA46534FFA46534FFA46534FF00000000A46534FFA465 + 34FFA46534FFB6BDBAFFA46534FFB6BDBAFFB6BDBAFFB6BDBAFFB6BDBAFFB6BD + BAFFA46534FFA46534FFA46534FFA46534FFA46534FF00000000A46534FFA465 + 34FFA46534FFB6BDBAFFA46534FFB6BDBAFFB6BDBAFFB6BDBAFFB6BDBAFFB6BD + BAFFA46534FFA46534FFA46534FFA46534FFA46534FF00000000A46534FFA465 + 34FFA46534FFB6BDBAFFB6BDBAFFB6BDBAFFB6BDBAFFB6BDBAFFB6BDBAFFB6BD + BAFFA46534FFA46534FFA46534FFA46534FFA46534FF00000000A46534FFA465 + 34FFA46534FFA46534FFA46534FFA46534FFA46534FFA46534FFA46534FFA465 + 34FFA46534FFA46534FFA46534FFA46534FFA46534FF00000000A46534FFA465 + 34FFA46534FFA46534FFA46534FFA46534FFA46534FFA46534FFA46534FFA465 + 34FFA46534FFA46534FFA46534FFA46534FFA46534FF00000000A46534FFECEE + EEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEE + EEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFA46534FF00000000A46534FFECEE + EEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEE + EEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFA46534FF00000000A46534FFECEE + EEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEE + EEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFA46534FF00000000A46534FFECEE + EEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEE + EEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFA46534FF00000000A46534FFECEE + EEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEE + EEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFA46534FF00000000A46534FFECEE + EEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFECEE + EEFFECEEEEFFECEEEEFFECEEEEFFECEEEEFFA46534FF00000000A46534FF5959 + F3FF5959F3FF5959F3FF5959F3FF5959F3FF5959F3FF5959F3FF5959F3FF5959 + F3FF5959F3FF5959F3FF5959F3FF5959F3FFA46534FF00000000A46534FF5959 + F3FF5959F3FF5959F3FF5959F3FF5959F3FF5959F3FF5959F3FF5959F3FF5959 + F3FF5959F3FF5959F3FF5959F3FF5959F3FFA46534FF00000000 + } + OnClick = BtnSaveMapProvidersClick + end end object MapView: TMapView Left = 0 Height = 545 Hint = 'Displays the map' Top = 0 - Width = 632 + Width = 592 Active = False Align = alClient CacheOnDisk = True diff --git a/components/lazmapviewer/example/main.pas b/components/lazmapviewer/example/main.pas index f33971dcd..11e844ea3 100644 --- a/components/lazmapviewer/example/main.pas +++ b/components/lazmapviewer/example/main.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs, - ExtCtrls, StdCtrls, ComCtrls, + ExtCtrls, StdCtrls, ComCtrls, Buttons, mvGeoNames, mvMapViewer, mvTypes, mvGpsObj; type @@ -40,6 +40,8 @@ type MapView: TMapView; GeoNames: TMVGeoNames; ControlPanel: TPanel; + BtnLoadMapProviders: TSpeedButton; + BtnSaveMapProviders: TSpeedButton; ZoomTrackBar: TTrackBar; procedure BtnGoToClick(Sender: TObject); procedure BtnSearchClick(Sender: TObject); @@ -60,6 +62,8 @@ type procedure MapViewMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure MapViewZoomChange(Sender: TObject); + procedure BtnLoadMapProvidersClick(Sender: TObject); + procedure BtnSaveMapProvidersClick(Sender: TObject); procedure ZoomTrackBarChange(Sender: TObject); private @@ -94,6 +98,7 @@ type const MAX_LOCATIONS_HISTORY = 50; HOMEDIR = ''; + MAP_PROVIDER_FILENAME = 'map-providers.xml'; var PointFormatSettings: TFormatsettings; @@ -106,15 +111,31 @@ end; { TMainForm } +procedure TMainForm.BtnLoadMapProvidersClick(Sender: TObject); +var + fn: String; + msg: String; +begin + fn := Application.Location + MAP_PROVIDER_FILENAME; + if FileExists(fn) then begin + if MapView.Engine.ReadProvidersFromXML(fn, msg) then begin + MapView.GetMapProviders(CbProviders.Items); + CbProviders.ItemIndex := 0; + MapView.MapProvider := CbProviders.Text; + end else + ShowMessage(msg); + end; +end; + +procedure TMainForm.BtnSaveMapProvidersClick(Sender: TObject); +begin + MapView.Engine.WriteProvidersToXML(Application.Location + MAP_PROVIDER_FILENAME); +end; + procedure TMainForm.BtnSearchClick(Sender: TObject); begin -// MapView.Center := GeoNames.Search(CbLocations.Text, MapView.DownloadEngine); - ClearFoundLocations; -// GeoNames.LocationName := CbLocations.Text; GeoNames.Search(CbLocations.Text, MapView.DownloadEngine); -// GeoNames.ListLocations(MapView.DownloadEngine); - //CbFoundLocations.Text := CbFoundLocations.Items[0]; UpdateDropdownWidth(CbFoundLocations); UpdateLocationHistory(CbLocations.Text); if CbFoundLocations.Items.Count > 0 then CbFoundLocations.ItemIndex := 0; @@ -276,7 +297,7 @@ begin txt := APoint.Name; bmp := TBitmap.Create; try -// bmp.PixelFormat := pf32Bit; +// bmp.PixelFormat := pf32Bit; // crashes Linux! w := bmp.Canvas.TextWidth(txt); h := bmp.Canvas.TextHeight(txt); bmp.SetSize(w, h); diff --git a/components/lazmapviewer/source/mvengine.pas b/components/lazmapviewer/source/mvengine.pas index 540463b55..e933ac744 100644 --- a/components/lazmapviewer/source/mvengine.pas +++ b/components/lazmapviewer/source/mvengine.pas @@ -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; diff --git a/components/lazmapviewer/source/mvmapprovider.pas b/components/lazmapviewer/source/mvmapprovider.pas index 917835eea..baab19c38 100644 --- a/components/lazmapviewer/source/mvmapprovider.pas +++ b/components/lazmapviewer/source/mvmapprovider.pas @@ -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.