Init

.gitignore

@@ -0,0 +1,2 @@
+Map/*
+Libs/*

Demo/MainUnit.dfm

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

Demo/MainUnit.pas

@@ -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.