FMXで国土地理院の地理院タイルを使用して地図を表示する ～Delphiでお手軽プログラミング

• ホーム
• Delphiでお手軽プログラミング
• FMXで国土地理院の地理院タイルを使用して地図を表示する ～Delphiでお手軽プログラミング

FMXで国土地理院の地理院タイルを使用して地図を表示する ～Delphiでお手軽プログラミング

～国土地理院のタイルマップを画像をインターネットからダウンロードして地図を表示する

１．Delphiを起動

２．ユニットの追加

unit UMamTileMap;

interface

uses
  FMX.Graphics,Math,system.classes, System.Types,
  System.Net.URLClient, System.Net.HttpClient,
  System.Net.HttpClientComponent,
  System.SysUtils,System.Threading
  ,FMX.Dialogs;

type
  TMapCompEvent=procedure(Sender:TObject;zxy:String) of object;
  PMap=^TMamTileMap;
  PObject=^TObject;
  TMamTileMap=class(TObject)
    private
      fCachePath:string;
      fNetHTTPClient:TNetHTTPClient;
      fRefPtr:Pointer;
      fNotify:TNotifyEvent;
      fMapList:TStringList;
      fZoom,fLat,fLng:Extended;
      fRange:Integer;
      fTileBmp:TBitmap;
      fResultBmp:TBitmap;
      procedure CreateResultBmp();
    public
      constructor Create(
        RefPtr:Pointer;
        CachePath:string;
        Notify:TNotifyEvent=nil
      );
      destructor Destroy();override;
      function getPxFromLat(zoom,lat:Extended):Extended;
      function getPxFromLng(zoom,lng:Extended):Extended;
      function getLatFromPx(zoom,px:Extended):Extended;
      function getLngFromPx(zoom,px:Extended):Extended;
      function getMapX(zoom,lat:Extended):Extended;
      function getMapY(zoom,lng:Extended):Extended;
      procedure getBitmap(zoom,lat,lng:Extended);
      procedure mapDownloadComplete(Sender:TObject;zxy:String);
      property ResultBmp:TBitmap read fResultBmp;
  end;

  TMapThread=class(TThread)
    private
      fz,fx,fy:Integer;
      fCachePath:string;
      fNetHTTPClient:TNetHTTPClient;
      fMapUrl:string;
      fTileBmp:TBitmap;
      fTileX,fTileY:Integer;
      fCanceled:Boolean;
      fMapCompEvent:TMapCompEvent;
    protected
      procedure Execute;override;
    public
      constructor Create(
        z,x,y:integer;
        CachePath:string;
        TileBmp:TBitmap;
        TileX,TileY:integer;
        MapCompEvent:TMapCompEvent);
      destructor Destroy();override;
      property z:Integer read fz;
      property x:Integer read fx;
      property y:Integer read fy;
      property Canceled:Boolean read fCanceled write fCanceled;
  end;

const
  ll:Extended=85.0511287798;

implementation

{ TMap }

constructor TMamTileMap.Create(
  RefPtr:Pointer;CachePath:string;
  Notify:TNotifyEvent=nil);
begin
  fRange:=2;
  fTileBmp:=TBitmap.Create;
  fTileBmp.Width :=256*(fRange*2+1);
  fTileBmp.Height:=256*(fRange*2+1);
  fResultBmp:=TBitmap.Create;
  fRefPtr:=RefPtr;
  fNetHTTPClient:=TNetHTTPClient.Create(nil);
  fCachePath:=CachePath;
  fNotify:=Notify;
  fMapList:=TStringList.Create;
end;

destructor TMamTileMap.Destroy;
begin
  fNetHTTPClient.Free;
  PObject(fRefPtr)^:=nil;
  fMapList.Free;
  FreeAndNil(fTileBmp);
  FreeAndNil(fResultBmp);
  inherited;
end;

procedure TMamTileMap.mapDownloadComplete(Sender: TObject;zxy:String);
var i:Integer;
begin
  i:=fMapList.IndexOf(zxy);
  if i>=0 then fMapList.Delete(i);
  CreateResultBmp();
  if Assigned(fNotify) then fNotify(self);
end;

function TMamTileMap.getLatFromPx(zoom, px: Extended): Extended;
begin
  //ズームとピクセルを与えると経度を返す
  result:=180*(px/Math.Power(2,floor(zoom)+7)-1);
end;

function TMamTileMap.getLngFromPx(zoom, px: Extended): Extended;
begin
  //ズームとピクセルを与えると緯度を返す
  result:=
    180/pi()*(
      ArcSin(
        Tanh(
          -pi()/Power(2,floor(zoom)+7)*px+
          ArcTanh(Sin(pi()/180*ll))
        )
      )
    );
end;

function TMamTileMap.getMapX(zoom,lat: Extended): Extended;
begin
  //ズームと経度を与えると何枚目のタイル(x)か返す
  Result:=getPxFromLat(floor(zoom),lat)/256;
end;

function TMamTileMap.getMapY(zoom,lng: Extended): Extended;
begin
  //ズームと緯度を与えると何枚目のタイル(y)か返す
  Result:=getPxFromLng(floor(zoom),lng)/256;
end;

procedure TMamTileMap.getBitmap(zoom, lat, lng: Extended);
var i,x,y,xx,yy:Integer;
    bmp:TBitmap;
    fname:string;
    st:string;
    stl:TStringList;
begin
  if(zoom>18.8)then zoom:=18.8;
  if(zoom<7)then zoom:=7;
  fZoom:=zoom;
  fLat:=lat;
  fLng:=lng;
  x:=Floor(getMapX(fZoom,fLat));
  y:=Floor(getMapY(fZoom,fLng));

  stl:=TStringList.Create;
  try
    stl.Assign(fMapList);
    for yy := y-fRange to y+fRange do
    begin
      for xx := x-fRange to x+fRange do
      begin
        fname:=format('%.6d%.6d%.6d.png',[floor(zoom),xx,yy]);
        i:=fMapList.IndexOf(fname);
        if i>=0 then
          stl.Delete(stl.IndexOf(fname));
      end;
    end;
    for i := 0 to stl.Count-1 do
    begin
      TMapThread(
        fMapList.Objects[fMapList.IndexOf(stl[i])]
      ).Canceled:=True;
    end;
  finally
    stl.Free;
  end;

  fTileBmp.Canvas.BeginScene();
  fTileBmp.Canvas.Fill.Kind:=TBrushKind.Solid;
  fTileBmp.Canvas.Fill.Color:=$FFFFFFFF;
  fTileBmp.Canvas.FillRect(
    RectF(0,0,fTileBmp.Width,fTileBmp.Height),
    0,0,[],1
  );
  fTileBmp.Canvas.EndScene;

  for yy := y-fRange to y+fRange do
  begin
    for xx := x-fRange to x+fRange do
    begin
      //先頭ゼロ埋め
      fname:=format('%.6d%.6d%.6d.png',[Floor(zoom),xx,yy]);
      if FileExists(fCachePath+'\'+fname) then
      begin
        bmp:=TBitmap.Create();
        try
          bmp.LoadFromFile(fCachePath+'\'+fname);
          fTileBmp.Canvas.BeginScene();
          fTileBmp.Canvas.DrawBitmap(
            bmp,
            RectF(0,0,255,255),
            RectF(
              (xx-(x-fRange)  )*256,(yy-(y-fRange)  )*256,
              (xx-(x-fRange)+1)*256,(yy-(y-fRange)+1)*256),
            1,true
          );
          fTileBmp.Canvas.EndScene;
        finally
          bmp.Free;
        end;
      end
      else
      begin
        st:=format('%.6d%.6d%.6d.png',[floor(zoom),xx,yy]);
        if fMapList.IndexOf(st)<0 then
        begin
          fMapList.AddObject(
            st,
            TMapThread.Create(
              floor(zoom),xx,yy,
              fCachePath,
              fTileBmp,
              xx-(x-fRange),yy-(y-fRange),
              mapDownloadComplete
            )
          );
        end;
      end;
    end;
  end;
  CreateResultBmp();
end;

function TMamTileMap.getPxFromLat(zoom,lat: Extended): Extended;
begin
  //ズームと経度を与えるとピクセル座標(x)を返す
  result:=Math.Power(2,floor(zoom)+7) * (lat/180+1);
end;

function TMamTileMap.getPxFromLng(zoom,lng: Extended): Extended;
begin
  //ズームと緯度を与えるとピクセル座標(y)を返す
  result:=Math.Power(2,floor(zoom)+7)/pi()*
    (
      -Math.ArcTanh(sin(pi()/180*lng))
      +Math.ArcTanh(sin(pi()/180*ll))
    );
end;

procedure TMamTileMap.CreateResultBmp;
var x,y:integer;
    pxx,pxy,zz:extended;
begin
  x:=floor(getMapX(fZoom,fLat));
  y:=floor(getMapY(fZoom,fLng));

  pxx:=getPxFromLat(fZoom,fLat)-(x-fRange)*256;
  pxy:=getPxFromLng(fZoom,fLng)-(y-fRange)*256;
  zz:=fZoom-floor(fZoom)+1;

  fResultBmp.Width:=(fRange+1)*256;
  fResultBmp.Height:=(fRange+1)*256;
  fResultBmp.Canvas.BeginScene();
  fResultBmp.Canvas.DrawBitmap(
    fTileBmp,
    RectF(
      pxx-(fResultBmp.Width/2)/zz,pxy-(fResultBmp.Height/2)/zz,
      pxx+(fResultBmp.Width/2)/zz,pxy+(fResultBmp.Height/2)/zz
    ),
    RectF(0,0,fResultBmp.Width,fResultBmp.Height),
    1,true
  );
  fResultBmp.Canvas.EndScene;
end;

{ TMapThread }

constructor TMapThread.Create(
        z,x,y:integer;
        CachePath:string;
        TileBmp:TBitmap;
        TileX,TileY:integer;
        MapCompEvent:TMapCompEvent);
begin
  inherited Create(false);
  //国土地理院の地理院タイルを使用する場合
  //利用規約は https://www.gsi.go.jp/kikakuchousei/kikakuchousei40182.html
  fMapUrl:=
    'https://cyberjapandata.gsi.go.jp/xyz/std/{z}/{x}/{y}.png';
  FreeOnTerminate:=true;
  fMapCompEvent:=MapCompEvent;
  fz:=z;
  fx:=x;
  fy:=y;
  fCachePath:=CachePath;
  fTileBmp:=TileBmp;
  fTileX:=TileX;
  fTileY:=TileY;
  fCanceled:=False;
  fNetHTTPClient:=TNetHTTPClient.Create(nil);
  fNetHTTPClient.ConnectionTimeout:=2000;
  fNetHTTPClient.ResponseTimeout:=2000;
  fNetHTTPClient.Asynchronous:=False;
end;

destructor TMapThread.Destroy;
begin
  fNetHTTPClient.Free;
  inherited;
end;

procedure TMapThread.Execute;
var
  res:IHTTPResponse;
  strm:TMemoryStream;
  url:string;
  fname:string;
  bmp:TBitmap;
  ct:Integer;
begin
  inherited;
  //先頭ゼロ埋め
  fname:=format('%.6d%.6d%.6d.png',[fz,fx,fy]);
  if not FileExists(fCachePath+'\'+fname) then
  begin
    url:=StringReplace(fMapUrl,'{z}',IntToStr(fz),[rfReplaceAll]);
    url:=StringReplace(url,'{x}',IntToStr(fx),[rfReplaceAll]);
    url:=StringReplace(url,'{y}',IntToStr(fy),[rfReplaceAll]);
    strm:=TMemoryStream.Create;
    try
      ct:=0;
      repeat
        res:=fNetHTTPClient.Get(url,strm);
        sleep(100);
        inc(ct);
      until (ct>10) or (res.StatusCode=200);
      if res.StatusCode=200 then
      begin
        if not fCanceled then
        begin
          Synchronize(procedure begin
            bmp:=TBitmap.Create;
            try
              bmp.LoadFromStream(strm);
              fTileBmp.Canvas.BeginScene();
              fTileBmp.Canvas.DrawBitmap(
                bmp,
                RectF(0,0,255,255),
                RectF(
                   fTileX   *256, fTileY   *256,
                  (fTileX+1)*256,(fTileY+1)*256),
                1,true
              );
              fTileBmp.Canvas.EndScene;
            finally
              bmp.Free;
            end;
          end);
        end;
        Synchronize(procedure begin
          strm.SaveToFile(fCachePath+'\'+fname);
        end);
      end;
    finally
      strm.Free;
    end;
    if (not fCanceled) and Assigned(fMapCompEvent) then
    begin
      fMapCompEvent(Self,fname);
    end;
  end;
end;

end.

２．Form1のソースコードの記述

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  System.Net.URLClient, System.Net.HttpClient, System.Net.HttpClientComponent,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Edit,
  Winapi.ShlObj,
  Winapi.windows,
  FMX.Platform.win,
  system.Math,
  Unit2;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Panel1: TPanel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Image1MouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; var Handled: Boolean);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
  private
    { private 宣言 }
    //bmp:FMX.Graphics.TBitmap;
    map:TMap;
    fZoom,fLat,fLng:Extended;
    procedure OnGetMap(Sender: TObject);
    procedure ShowMap();
  public
    { public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
var pw:PWideChar;
    CachePath:string;
begin
  //キャッシュフォルダを取得する
  GetMem(pw,2048);
  try
    ZeroMemory(pw,2048);
    SHGetSpecialFolderPath(
      WindowHandleToPlatform(Handle).Wnd,
      pw,CSIDL_LOCAL_APPDATA,
      false
    );
    CachePath:=pw;
  finally
    FreeMem(pw);
  end;
  CachePath:=CachePath+'\mam\gis\cache';

  //キャッシュフォルダを作成する
  if not DirectoryExists(CachePath) then
    ForceDirectories(CachePath);

  //インスタンスの作成
  map:=TMap.Create(@map,CachePath,OnGetMap);

  //初期値の設定
  fZoom:=18;        //ズーム18
  fLat:=139.69167; //東経
  fLng:=35.68944;  //北緯

  ShowMap();
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  map.Free;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
var px,py:Extended;
//    bmp:FMX.Graphics.TBitmap;
    ImgRatio:Extended;
//    mxy:extended;
begin
  //ズームと東経からピクセル値を取得
  px:=map.getPxFromLat(fZoom,fLat);
  //ズームと北緯からピクセル値を取得
  py:=map.getPxFromLng(fZoom,fLng);

  if Image1.Width<Image1.Height then
    ImgRatio:=Image1.Bitmap.Width/Image1.Width
  else
    ImgRatio:=Image1.Bitmap.Height/Image1.Height;

  px:=px+(X-Image1.Width/2)*ImgRatio;
  py:=py+(Y-Image1.Height/2)*ImgRatio;
  //マウス座標の経度緯度を取得
  fLat:=map.getLatFromPx(fZoom,px);
  fLng:=map.getLngFromPx(fZoom,py);
  ShowMap();
end;

procedure TForm1.Image1MouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; var Handled: Boolean);
begin
  if WheelDelta<0 then fZoom:=fZoom-0.2 else fZoom:=fZoom+0.2;
  if fZoom<7 then fZoom:=7;
  if fZoom>18.8 then fZoom:=18.8;
  ShowMap();
end;

procedure TForm1.OnGetMap(Sender: TObject);
begin
  Image1.Bitmap.Assign(TMap(Sender).ResultBmp);
end;

procedure TForm1.ShowMap;
//var bmp:FMX.Graphics.TBitmap;
begin
  Edit1.Text:=format('%4.1f',[fZoom]);
  Edit2.Text:=format('%9.4f',[fLat]);
  Edit3.Text:=format('%9.4f',[fLng]);
  map.getBitmap(fZoom,fLat,fLng);
  Image1.Bitmap.Assign(map.ResultBmp);
end;

end.

３．実行する