-
Notifications
You must be signed in to change notification settings - Fork 22
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
0 parents
commit 9d48e26
Showing
13 changed files
with
2,196 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,2 @@ | ||
Map/* | ||
Libs/* |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,168 @@ | ||
object MainForm: TMainForm | ||
Left = 16 | ||
Top = 116 | ||
Caption = 'Test of OSM map control' | ||
ClientHeight = 720 | ||
ClientWidth = 1003 | ||
Color = clBtnFace | ||
DoubleBuffered = True | ||
Font.Charset = DEFAULT_CHARSET | ||
Font.Color = clWindowText | ||
Font.Height = -14 | ||
Font.Name = 'MS Sans Serif' | ||
Font.Style = [] | ||
OldCreateOrder = False | ||
Position = poScreenCenter | ||
OnClose = FormClose | ||
OnCreate = FormCreate | ||
OnDestroy = FormDestroy | ||
PixelsPerInch = 120 | ||
TextHeight = 16 | ||
object Splitter1: TSplitter | ||
Left = 767 | ||
Top = 0 | ||
Width = 8 | ||
Height = 576 | ||
Margins.Left = 4 | ||
Margins.Top = 4 | ||
Margins.Right = 4 | ||
Margins.Bottom = 4 | ||
Align = alRight | ||
Beveled = True | ||
end | ||
object Panel1: TPanel | ||
Left = 0 | ||
Top = 0 | ||
Width = 767 | ||
Height = 576 | ||
Margins.Left = 4 | ||
Margins.Top = 4 | ||
Margins.Right = 4 | ||
Margins.Bottom = 4 | ||
Align = alClient | ||
BevelOuter = bvNone | ||
TabOrder = 0 | ||
object mMap: TScrollBox | ||
Left = 0 | ||
Top = 0 | ||
Width = 767 | ||
Height = 576 | ||
HorzScrollBar.Tracking = True | ||
VertScrollBar.Smooth = True | ||
VertScrollBar.Tracking = True | ||
Align = alClient | ||
AutoScroll = False | ||
DoubleBuffered = True | ||
DragCursor = crSizeAll | ||
ParentDoubleBuffered = False | ||
TabOrder = 0 | ||
OnMouseMove = mMapMouseMove | ||
end | ||
end | ||
object Panel2: TPanel | ||
Left = 775 | ||
Top = 0 | ||
Width = 228 | ||
Height = 576 | ||
Margins.Left = 4 | ||
Margins.Top = 4 | ||
Margins.Right = 4 | ||
Margins.Bottom = 4 | ||
Align = alRight | ||
BevelOuter = bvNone | ||
TabOrder = 1 | ||
object btnZoomIn: TSpeedButton | ||
Left = 100 | ||
Top = 13 | ||
Width = 51 | ||
Height = 36 | ||
Margins.Left = 4 | ||
Margins.Top = 4 | ||
Margins.Right = 4 | ||
Margins.Bottom = 4 | ||
Glyph.Data = { | ||
66010000424D6601000000000000760000002800000014000000140000000100 | ||
040000000000F000000000000000000000001000000000000000000000000000 | ||
8000008000000080800080000000800080008080000080808000C0C0C0000000 | ||
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00EEEEEEEEEEEE | ||
EEEEEEEE0000EEEEEEEEEEEEEEEEEEEE0000EEEEEEEEEEEEEEEEEEEE0000EEEE | ||
EEE000000EEEEEEE0000EEEEEE0FFFFFF0EEEEEE0000EEEEE0FFFFFFFF0EEEEE | ||
0000EEEE0FFFFFFFFFF0EEEE0000EEE0FFFFFCCFFFF0EEEE0000EEE0FFFFFCCF | ||
FFFF0EEE0000EEE0FFFCCCCCCFFF0EEE0000EEE0FFFCCCCCCFFF0EEE0000EEE0 | ||
FFFFFCCFFFFF0EEE0000EEE0FFFFFCCFFFF0EEEE0000EEEE0FFFFFFFFFF0EEEE | ||
0000EEEEE0FFFFFFFF0EEEEE0000EEEEEE0FFFFFF0EEEEEE0000EEEEEEE00000 | ||
0EEEEEEE0000EEEEEEEEEEEEEEEEEEEE0000EEEEEEEEEEEEEEEEEEEE0000EEEE | ||
EEEEEEEEEEEEEEEE0000} | ||
OnClick = btnZoomInClick | ||
end | ||
object btnZoomOut: TSpeedButton | ||
Left = 164 | ||
Top = 13 | ||
Width = 51 | ||
Height = 36 | ||
Margins.Left = 4 | ||
Margins.Top = 4 | ||
Margins.Right = 4 | ||
Margins.Bottom = 4 | ||
Glyph.Data = { | ||
66010000424D6601000000000000760000002800000014000000140000000100 | ||
040000000000F000000000000000000000001000000000000000000000000000 | ||
8000008000000080800080000000800080008080000080808000C0C0C0000000 | ||
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00EEEEEEEEEEEE | ||
EEEEEEEE0000EEEEEEEEEEEEEEEEEEEE0000EEEEEEEEEEEEEEEEEEEE0000EEEE | ||
EEE000000EEEEEEE0000EEEEEE0FFFFFF0EEEEEE0000EEEEE0FFFFFFFF0EEEEE | ||
0000EEEE0FFFFFFFFFF0EEEE0000EEE0FFFFFFFFFFF0EEEE0000EEE0FFFFFFFF | ||
FFFF0EEE0000EEE0FFFCCCCCCFFF0EEE0000EEE0FFFCCCCCCFFF0EEE0000EEE0 | ||
FFFFFFFFFFFF0EEE0000EEE0FFFFFFFFFFF0EEEE0000EEEE0FFFFFFFFFF0EEEE | ||
0000EEEEE0FFFFFFFF0EEEEE0000EEEEEE0FFFFFF0EEEEEE0000EEEEEEE00000 | ||
0EEEEEEE0000EEEEEEEEEEEEEEEEEEEE0000EEEEEEEEEEEEEEEEEEEE0000EEEE | ||
EEEEEEEEEEEEEEEE0000} | ||
OnClick = btnZoomOutClick | ||
end | ||
object Label1: TLabel | ||
Left = 16 | ||
Top = 488 | ||
Width = 41 | ||
Height = 16 | ||
Caption = 'Label1' | ||
end | ||
object Label2: TLabel | ||
Left = 16 | ||
Top = 512 | ||
Width = 41 | ||
Height = 16 | ||
Caption = 'Label2' | ||
end | ||
object lblZoom: TLabel | ||
Left = 7 | ||
Top = 13 | ||
Width = 74 | ||
Height = 36 | ||
AutoSize = False | ||
Font.Charset = RUSSIAN_CHARSET | ||
Font.Color = clWindowText | ||
Font.Height = -17 | ||
Font.Name = 'Tahoma' | ||
Font.Style = [fsBold] | ||
ParentFont = False | ||
Layout = tlCenter | ||
end | ||
object Button1: TButton | ||
Left = 24 | ||
Top = 256 | ||
Width = 177 | ||
Height = 33 | ||
Caption = 'Save layer' | ||
TabOrder = 0 | ||
OnClick = Button1Click | ||
end | ||
end | ||
object mLog: TMemo | ||
Left = 0 | ||
Top = 576 | ||
Width = 1003 | ||
Height = 144 | ||
Align = alBottom | ||
TabOrder = 2 | ||
end | ||
end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,221 @@ | ||
unit MainUnit; | ||
|
||
interface | ||
|
||
uses | ||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, | ||
Dialogs, ExtCtrls, Buttons, Vcl.StdCtrls, Math, Types, | ||
OSM.SlippyMapUtils, OSM.MapControl, OSM.TileStorage, | ||
OSM.NetworkRequest, {SynapseRequest,} WinInetRequest; | ||
|
||
const | ||
MSG_GOTTILE = WM_APP + 200; | ||
|
||
type | ||
// Nice trick to avoid registering TMapControl as design-time component | ||
TScrollBox = class(TMapControl) | ||
end; | ||
|
||
TGotTileData = record | ||
Tile: TTile; | ||
Ms: TMemoryStream; | ||
Error: string; | ||
end; | ||
PGotTileData = ^TGotTileData; | ||
|
||
TMainForm = class(TForm) | ||
Panel1: TPanel; | ||
Panel2: TPanel; | ||
Splitter1: TSplitter; | ||
btnZoomIn: TSpeedButton; | ||
btnZoomOut: TSpeedButton; | ||
Button1: TButton; | ||
mMap: TScrollBox; | ||
mLog: TMemo; | ||
Label1: TLabel; | ||
Label2: TLabel; | ||
lblZoom: TLabel; | ||
procedure FormCreate(Sender: TObject); | ||
procedure FormClose(Sender: TObject; var Action: TCloseAction); | ||
procedure FormDestroy(Sender: TObject); | ||
procedure btnZoomInClick(Sender: TObject); | ||
procedure btnZoomOutClick(Sender: TObject); | ||
procedure Button1Click(Sender: TObject); | ||
procedure mMapMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); | ||
|
||
procedure MapGetTile(Sender: TMapControl; TileHorzNum, TileVertNum: Cardinal; out TileBmp: TBitmap); | ||
procedure MsgGotTile(var Message: TMessage); message MSG_GOTTILE; | ||
procedure NetReqGotTile(const Tile: TTile; Ms: TMemoryStream; const Error: string); | ||
procedure mMapZoomChanged(Sender: TObject); | ||
private | ||
NetworkRequest: TNetworkRequestQueue; | ||
TileStorage: TTileStorage; | ||
procedure Log(const s: string); | ||
end; | ||
|
||
var | ||
MainForm: TMainForm; | ||
|
||
implementation | ||
|
||
{$R *.dfm} | ||
|
||
{ TMainForm } | ||
|
||
procedure TMainForm.FormCreate(Sender: TObject); | ||
begin | ||
// Memory/disc cache of tile images | ||
// You probably won't need it if you have another fast storage (f.e. database) | ||
TileStorage := TTileStorage.Create(30); | ||
TileStorage.FileCacheBaseDir := ExpandFileName('..\Map\'); | ||
// Queuer of tile image network requests | ||
// You won't need it if you have another source (f.e. database) | ||
NetworkRequest := TNetworkRequestQueue.Create(4, 3, {}{SynapseRequest.}WinInetRequest.NetworkRequest, NetReqGotTile); | ||
|
||
mMap.OnGetTile := MapGetTile; | ||
mMap.OnZoomChanged := mMapZoomChanged; | ||
mMap.SetZoom(1); | ||
end; | ||
|
||
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); | ||
begin | ||
//... | ||
end; | ||
|
||
procedure TMainForm.FormDestroy(Sender: TObject); | ||
begin | ||
FreeAndNil(NetworkRequest); | ||
FreeAndNil(TileStorage); | ||
end; | ||
|
||
procedure TMainForm.Log(const s: string); | ||
begin | ||
mLog.Lines.Add(DateTimeToStr(Now)+' '+s); | ||
OutputDebugString(PChar(DateTimeToStr(Now)+' '+s)); | ||
end; | ||
|
||
// Callback from map control to receive a tile image | ||
procedure TMainForm.MapGetTile(Sender: TMapControl; TileHorzNum, TileVertNum: Cardinal; out TileBmp: TBitmap); | ||
var | ||
Tile: TTile; | ||
begin | ||
Tile.Zoom := Sender.Zoom; | ||
Tile.ParameterX := TileHorzNum; | ||
Tile.ParameterY := TileVertNum; | ||
|
||
// Query tile from storage | ||
TileBmp := TileStorage.GetTile(Tile); | ||
|
||
// Tile image unavailable - queue network request | ||
if TileBmp = nil then | ||
begin | ||
NetworkRequest.RequestTile(Tile); | ||
Log(Format('Queued request from inet %s', [TileToStr(Tile)])); | ||
end; | ||
end; | ||
|
||
// Callback from a thread of network requester that request has been done | ||
// To avoid thread access troubles, re-post all the data to form | ||
procedure TMainForm.NetReqGotTile(const Tile: TTile; Ms: TMemoryStream; const Error: string); | ||
var | ||
pData: PGotTileData; | ||
begin | ||
New(pData); | ||
pData.Tile := Tile; | ||
pData.Ms := Ms; | ||
pData.Error := Error; | ||
if not PostMessage(Handle, MSG_GOTTILE, 0, LPARAM(pData)) then | ||
begin | ||
Dispose(pData); | ||
FreeAndNil(Ms); | ||
end; | ||
end; | ||
|
||
procedure TMainForm.MsgGotTile(var Message: TMessage); | ||
var | ||
pData: PGotTileData; | ||
begin | ||
pData := PGotTileData(Message.LParam); | ||
if pData.Error <> '' then | ||
begin | ||
Log(Format('Error getting tile %s: %s', [TileToStr(pData.Tile), pData.Error])); | ||
end | ||
else | ||
begin | ||
Log(Format('Got from inet %s', [TileToStr(pData.Tile)])); | ||
TileStorage.StoreTile(pData.Tile, pData.Ms); | ||
mMap.RefreshTile(pData.Tile.ParameterX, pData.Tile.ParameterY); | ||
end; | ||
FreeAndNil(pData.Ms); | ||
Dispose(pData); | ||
end; | ||
|
||
procedure TMainForm.btnZoomInClick(Sender: TObject); | ||
begin | ||
mMap.SetZoom(mMap.Zoom + 1); | ||
end; | ||
|
||
procedure TMainForm.btnZoomOutClick(Sender: TObject); | ||
begin | ||
mMap.SetZoom(mMap.Zoom - 1); | ||
end; | ||
|
||
procedure TMainForm.Button1Click(Sender: TObject); | ||
var | ||
bmp, bmTile: TBitmap; | ||
col, row: Integer; | ||
tile: TTile; | ||
imgAbsent: Boolean; | ||
begin | ||
bmp := TBitmap.Create; | ||
bmp.Height := TileCount(mMap.Zoom)*TILE_IMAGE_HEIGHT; | ||
bmp.Width := TileCount(mMap.Zoom)*TILE_IMAGE_WIDTH; | ||
|
||
try | ||
imgAbsent := False; | ||
for col := 0 to TileCount(mMap.Zoom) - 1 do | ||
for row := 0 to TileCount(mMap.Zoom) - 1 do | ||
begin | ||
tile.Zoom := mMap.Zoom; | ||
tile.ParameterX := col; | ||
tile.ParameterY := row; | ||
bmTile := TileStorage.GetTile(tile); | ||
if bmTile = nil then | ||
begin | ||
NetworkRequest.RequestTile(tile); | ||
imgAbsent := True; | ||
Continue; | ||
end; | ||
bmp.Canvas.Draw(col*TILE_IMAGE_WIDTH, row*TILE_IMAGE_HEIGHT, bmTile); | ||
end; | ||
|
||
if imgAbsent then | ||
begin | ||
ShowMessage('Some images were absent'); | ||
Exit; | ||
end; | ||
|
||
bmp.SaveToFile('Map'+IntToStr(mMap.Zoom)+'.bmp'); | ||
ShowMessage('Saved to Map'+IntToStr(mMap.Zoom)+'.bmp'); | ||
finally | ||
FreeAndNil(bmp); | ||
end; | ||
end; | ||
|
||
procedure TMainForm.mMapMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); | ||
var | ||
MapPt: TPoint; | ||
GeoPt: TPointF; | ||
begin | ||
MapPt := mMap.ViewToMap(Point(X, Y)); | ||
GeoPt := mMap.MapToGeoCoords(MapPt); | ||
Label1.Caption := Format('%d : %d', [MapPt.X, MapPt.Y]); | ||
Label2.Caption := Format('%.3f : %.3f', [GeoPt.X, GeoPt.Y]); | ||
end; | ||
|
||
procedure TMainForm.mMapZoomChanged(Sender: TObject); | ||
begin | ||
lblZoom.Caption := Format('%d / %d', [TMapControl(Sender).Zoom, High(TMapZoomLevel)]); | ||
end; | ||
|
||
end. |
Oops, something went wrong.