Skip to content

Commit

Permalink
Demo: + support multiple providers
Browse files Browse the repository at this point in the history
  • Loading branch information
@Fr0sT-Brutal
Fr0sT-Brutal committed Oct 28, 2022
1 parent c5d3fa0 commit 892f710
Show file tree
Hide file tree
Showing 2 changed files with 91 additions and 54 deletions.
56 changes: 32 additions & 24 deletions Demo/MainUnit.dfm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -93,7 +93,7 @@ object MainForm: TMainForm
Left = 0
Top = 0
Width = 228
Height = 602
Height = 711
Align = alClient
ColumnCollection = <
item
Expand Down Expand Up @@ -141,7 +141,7 @@ object MainForm: TMainForm
end
item
SizeStyle = ssAbsolute
Value = 150.000000000000000000
Value = 160.000000000000000000
end
item
SizeStyle = ssAbsolute
Expand Down Expand Up @@ -327,7 +327,7 @@ object MainForm: TMainForm
Left = 1
Top = 101
Width = 226
Height = 150
Height = 160
Align = alClient
BevelOuter = bvNone
TabOrder = 2
Expand All @@ -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 = (
Expand All @@ -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
Expand Down Expand Up @@ -467,7 +475,7 @@ object MainForm: TMainForm
end
object Panel7: TPanel
Left = 1
Top = 411
Top = 421
Width = 226
Height = 140
Align = alClient
Expand Down Expand Up @@ -527,7 +535,7 @@ object MainForm: TMainForm
end
object Panel8: TPanel
Left = 1
Top = 551
Top = 561
Width = 226
Height = 50
Align = alClient
Expand Down Expand Up @@ -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
Expand Down
89 changes: 59 additions & 30 deletions Demo/MainUnit.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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);
Expand All @@ -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 }
Expand All @@ -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;
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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);
Expand All @@ -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;
Expand Down Expand Up @@ -455,14 +470,23 @@ 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
TileStorage.ClearCache;
suite := TMapTestCase.Create(mMap, Log);
suite.Run;
FreeAndNil(suite);
InitMap;
mMap.Refresh;
end;

Expand Down Expand Up @@ -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.

0 comments on commit 892f710

Please sign in to comment.