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

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.Control = BtnLoadMapProviders
-      AnchorSideRight.Side = asrBottom
       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

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);

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;

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;
-  TGetSvrStr = function (id: integer): string of object;
+  TGetValStr = function (const Tile: TTileId): String;
-  TGetValStr = function (const Tile: TTileId): String of object;
 
   { 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.