From 892f7101ec304951630154b221ca8024daa858c0 Mon Sep 17 00:00:00 2001 From: Fr0sT-Brutal Date: Fri, 28 Oct 2022 16:53:18 +0300 Subject: [PATCH] Demo: + support multiple providers --- Demo/MainUnit.dfm | 56 ++++++++++++++++------------- Demo/MainUnit.pas | 89 +++++++++++++++++++++++++++++++---------------- 2 files changed, 91 insertions(+), 54 deletions(-) diff --git a/Demo/MainUnit.dfm b/Demo/MainUnit.dfm index 230eff7..16bba49 100644 --- a/Demo/MainUnit.dfm +++ b/Demo/MainUnit.dfm @@ -2,8 +2,8 @@ object MainForm: TMainForm Left = 16 Top = 116 Caption = 'Test of OSM map control' - ClientHeight = 746 - ClientWidth = 1051 + ClientHeight = 855 + ClientWidth = 975 Color = clBtnFace DoubleBuffered = True Font.Charset = DEFAULT_CHARSET @@ -19,10 +19,10 @@ object MainForm: TMainForm PixelsPerInch = 120 TextHeight = 16 object Splitter1: TSplitter - Left = 815 + Left = 739 Top = 0 Width = 8 - Height = 602 + Height = 711 Margins.Left = 4 Margins.Top = 4 Margins.Right = 4 @@ -33,8 +33,8 @@ object MainForm: TMainForm object Panel1: TPanel Left = 0 Top = 0 - Width = 815 - Height = 602 + Width = 739 + Height = 711 Margins.Left = 4 Margins.Top = 4 Margins.Right = 4 @@ -45,18 +45,18 @@ object MainForm: TMainForm object mMap: TScrollBox Left = 0 Top = 0 - Width = 815 - Height = 602 + Width = 739 + Height = 711 Align = alClient TabOrder = 0 OnMouseMove = mMapMouseMove end end object Panel2: TPanel - Left = 823 + Left = 747 Top = 0 Width = 228 - Height = 602 + Height = 711 Margins.Left = 4 Margins.Top = 4 Margins.Right = 4 @@ -93,7 +93,7 @@ object MainForm: TMainForm Left = 0 Top = 0 Width = 228 - Height = 602 + Height = 711 Align = alClient ColumnCollection = < item @@ -141,7 +141,7 @@ object MainForm: TMainForm end item SizeStyle = ssAbsolute - Value = 150.000000000000000000 + Value = 160.000000000000000000 end item SizeStyle = ssAbsolute @@ -327,7 +327,7 @@ object MainForm: TMainForm Left = 1 Top = 101 Width = 226 - Height = 150 + Height = 160 Align = alClient BevelOuter = bvNone TabOrder = 2 @@ -336,8 +336,8 @@ object MainForm: TMainForm Left = 3 Top = 3 Width = 220 - Height = 114 - Align = alClient + Height = 96 + Align = alTop Caption = ' Proxy ' ItemIndex = 1 Items.Strings = ( @@ -348,18 +348,26 @@ object MainForm: TMainForm end object eProxyAddr: TEdit AlignWithMargins = True - Left = 3 - Top = 123 - Width = 220 + Left = 6 + Top = 105 + Width = 211 Height = 24 - Align = alBottom TabOrder = 1 TextHint = 'host:port' end + object cbProvider: TComboBox + Left = 8 + Top = 136 + Width = 209 + Height = 24 + Style = csDropDownList + TabOrder = 2 + OnChange = cbProviderChange + end end object Panel6: TPanel Left = 1 - Top = 251 + Top = 261 Width = 226 Height = 160 Align = alClient @@ -467,7 +475,7 @@ object MainForm: TMainForm end object Panel7: TPanel Left = 1 - Top = 411 + Top = 421 Width = 226 Height = 140 Align = alClient @@ -527,7 +535,7 @@ object MainForm: TMainForm end object Panel8: TPanel Left = 1 - Top = 551 + Top = 561 Width = 226 Height = 50 Align = alClient @@ -556,8 +564,8 @@ object MainForm: TMainForm end object mLog: TMemo Left = 0 - Top = 602 - Width = 1051 + Top = 711 + Width = 975 Height = 144 Align = alBottom ScrollBars = ssVertical diff --git a/Demo/MainUnit.pas b/Demo/MainUnit.pas index 6a493f3..98229a3 100644 --- a/Demo/MainUnit.pas +++ b/Demo/MainUnit.pas @@ -33,7 +33,10 @@ interface {$ELSE} , OSM.NetworkRequest.WinInet // Use WinInet (Windows only) for HTTP requests {$ENDIF} + , OSM.TilesProvider , OSM.TilesProvider.OSM + , OSM.TilesProvider.Google + , OSM.TilesProvider.HERE , TestSuite; const @@ -97,6 +100,7 @@ TMainForm = class(TForm) chbLayer3: TCheckBox; chbLayer4: TCheckBox; Button3: TButton; + cbProvider: TComboBox; procedure btnGoLatLongClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); @@ -119,11 +123,12 @@ TMainForm = class(TForm) procedure chbCacheSaveFilesClick(Sender: TObject); procedure chbLayer1Click(Sender: TObject); procedure Button1Click(Sender: TObject); + procedure cbProviderChange(Sender: TObject); private NetRequest: TNetworkRequestQueue; TileStorage: TTileStorage; procedure Log(const s: string); - procedure InitMap; + procedure SetTilesProvider(TilesProviderClass: TTilesProviderClass); end; { TMapTestCase } @@ -134,6 +139,7 @@ TMapTestCase = class(TTestSuite) public constructor Create(Map: TMapControl; LogProc: TLogProc); procedure Setup; override; + procedure Teardown; override; // Tests procedure TestZoom; procedure TestPosition; @@ -186,6 +192,20 @@ procedure TMapTestCase.Setup; Form.Height := Form.Height - (ClRect.Height - StdMapSize.cy); end; +// Return all changed values +procedure TMapTestCase.Teardown; +var Form: TMainForm; +begin + Form := FMap.Owner as TMainForm; + FMap.OnDrawTile := Form.mMapDrawTile; + FMap.OnZoomChanged := Form.mMapZoomChanged; + FMap.OnSelectionBox := Form.mMapSelectionBox; + FMap.MapMarkCaptionFont.Style := [fsItalic, fsBold]; + FMap.SetZoom(1); + + // TODO Return form bounds, etc... +end; + procedure TMapTestCase.TestZoom; var OldZoom, OldMinZoom, OldMaxZoom: TMapZoomLevel; @@ -236,33 +256,23 @@ procedure TMapTestCase.TestPosition; end; end; -procedure TMainForm.btnGoLatLongClick(Sender: TObject); -var - LGeoPoint: TGeoPoint; -begin - mMap.SetZoom(13); - LGeoPoint.Long := StrToFloat(editLongitude.Text); - LGeoPoint.Lat := StrToFloat(editLatitude.Text); - mMap.CenterPoint := LGeoPoint; -end; - { TMainForm } procedure TMainForm.FormCreate(Sender: TObject); -var s: string; +var tpc: TTilesProviderClass; begin + mMap.OnDrawTile := mMapDrawTile; + mMap.OnZoomChanged := mMapZoomChanged; + mMap.OnSelectionBox := mMapSelectionBox; + mMap.MapMarkCaptionFont.Style := [fsItalic, fsBold]; // Memory/disc cache of tile images // You probably won't need it if you have another fast storage (f.e. database) TileStorage := TTileStorage.Create(50*1000*1000); - TileStorage.FileCacheBaseDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'Map'; - // Queuer of tile image network requests - // You won't need it if you have another source (f.e. database) - NetRequest := TNetworkRequestQueue.Create(4, 3, NetworkRequest, TOSMTilesProvider.Create); - NetRequest.RequestProps.HeaderLines := TStringList.Create; - NetRequest.OnGotTileBgThr := NetReqGotTileBgThr; - for s in SampleHeaders do - NetRequest.RequestProps.HeaderLines.Add(s); - InitMap; + for tpc in TilesProviders do + cbProvider.Items.Add(tpc.Name); + cbProvider.ItemIndex := 0; + cbProvider.OnChange(cbProvider); + mMap.SetZoom(1); end; procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); @@ -284,15 +294,20 @@ procedure TMainForm.Log(const s: string); {$IFEND} end; -// Extracted to separate method to re-init the control after test -procedure TMainForm.InitMap; +procedure TMainForm.SetTilesProvider(TilesProviderClass: TTilesProviderClass); +var s: string; begin - mMap.OnDrawTile := mMapDrawTile; - mMap.OnZoomChanged := mMapZoomChanged; - mMap.OnSelectionBox := mMapSelectionBox; - mMap.TilesProvider := TOSMTilesProvider.Create; - mMap.SetZoom(1); - mMap.MapMarkCaptionFont.Style := [fsItalic, fsBold]; + TileStorage.FileCacheBaseDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + + 'Map' + PathDelim + TilesProviderClass.Name; + // Queuer of tile image network requests + // You won't need it if you have another source (f.e. database) + FreeAndNil(NetRequest); + NetRequest := TNetworkRequestQueue.Create(4, 3, NetworkRequest, TilesProviderClass.Create); + NetRequest.RequestProps.HeaderLines := TStringList.Create; + NetRequest.OnGotTileBgThr := NetReqGotTileBgThr; + for s in SampleHeaders do + NetRequest.RequestProps.HeaderLines.Add(s); + mMap.TilesProvider := TilesProviderClass.Create; end; function TMainForm.mMapGetTile(Sender: TMapControl; TileHorzNum, TileVertNum: Cardinal): TBitmap; @@ -455,6 +470,16 @@ procedure TMainForm.btnMouseModeSelClick(Sender: TObject); mMap.MouseMode := mmSelect; end; +procedure TMainForm.btnGoLatLongClick(Sender: TObject); +var + LGeoPoint: TGeoPoint; +begin + mMap.SetZoom(13); + LGeoPoint.Long := StrToFloat(editLongitude.Text); + LGeoPoint.Lat := StrToFloat(editLatitude.Text); + mMap.CenterPoint := LGeoPoint; +end; + procedure TMainForm.btnTestClick(Sender: TObject); var suite: TMapTestCase; begin @@ -462,7 +487,6 @@ procedure TMainForm.btnTestClick(Sender: TObject); suite := TMapTestCase.Create(mMap, Log); suite.Run; FreeAndNil(suite); - InitMap; mMap.Refresh; end; @@ -499,5 +523,10 @@ procedure TMainForm.Button1Click(Sender: TObject); FreeAndNil(bmp); end; +procedure TMainForm.cbProviderChange(Sender: TObject); +begin + SetTilesProvider(TilesProviders[(Sender as TComboBox).ItemIndex]); +end; + end.