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