Google Geocoding API for Delphi - AddressToGeolocation and GeolocationToAddress

Example.pas

unit Example;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

uses
  iPub.Rtl.Geolocation,
  iPub.Rtl.Geolocation.Google;

procedure TForm1.FormCreate(Sender: TObject);
var
  LGeolocation: TipGeolocation;
  LGoogleGeocoding: TipGoogleGeocoding;
begin
  LGoogleGeocoding := TipGoogleGeocoding.Create('<YOUR_GOOGLE_MAPS_AKI_KEY');
  try
    case LGoogleGeocoding.TryAddressToGeolocation('Av. Paulista, 1578 - Bela Vista, São Paulo - SP', TipIdiom.PortugueseBrazil, LGeolocation) of
      TipGoogleGeocodingResult.Success: Showmessage(Format('Latitude: %g Longitude: %g', [LGeolocation.Latitude, LGeolocation.Longitude]));
      TipGoogleGeocodingResult.NotFound: Showmessage('Address not found!');
      TipGoogleGeocodingResult.Failed: Showmessage('Service failed!');
    end;
  finally
    LGoogleGeocoding.Free;
  end;
end;

end.

iPub.Rtl.Geolocation.Google.pas

unit iPub.Rtl.Geolocation.Google;

interface

{$SCOPEDENUMS ON}

uses
  { Delphi }
  System.SysUtils,
  System.JSON.Serializers,

  { iPub }
  iPub.Rtl.Geolocation,
  iPub.Rtl.Refit; // Found in https://github.com/viniciusfbb/ipub-refit

type
  TipIdiom = (English, PortugueseBrazil);
  TipGoogleGeocodingResult = (Success, NotFound, Failed);
  EipGoogleGeocoding = class(Exception);

  { TipGoogleGeocoding }

  TipGoogleGeocoding = class
  {$REGION ' - Internal use'}
  strict private
    type
      TStatusCode  = (OK, ZERO_RESULTS, OVER_DAILY_LIMIT, OVER_QUERY_LIMIT, REQUEST_DENIED, INVALID_REQUEST, UNKNOWN_ERROR);

      TGeolocation = record
        [JsonName('lat')] Latitude: Double;
        [JsonName('lng')] Longitude: Double;
      end;

      TAddressGeometry = record
        Location: TGeolocation;
      end;

      TAddressComponent = record
        [JsonName('long_name')] LongName: string;
        [JsonName('short_name')] ShortName: string;
        Types: TArray<string>;
      end;

      TAddress = record
        [JsonName('address_components')] AddressComponents: TArray<TAddressComponent>;
        [JsonName('formatted_address')] FormattedAddress: string;
        Geometry: TAddressGeometry;
        Types: TArray<string>;
      end;

      TGoogleGeolocationResponse = record
        [JsonName('error_message')] ErrorMessage: string;
        Results: TArray<TAddress>;
        Status: TStatusCode;
      end;

      TGoogleAddressResponse = record
        [JsonName('error_message')] ErrorMessage: string;
        Results: TArray<TAddress>;
        Status: TStatusCode;
      end;

      [BaseUrl('https://maps.googleapis.com')]
      IipGoogleMapsAPI = interface(IipRestApi)
        ['{668C5505-F90D-43C0-9545-038A86472666}']
        [Get('/maps/api/geocode/json?address={AAddress}&key={ApiKey}')]
        [Headers('Accept-Language', '{ALanguage},en-US;q=0.5')]
        function TryAddressToGeolocation(const AAddress: string; out AResult: TGoogleGeolocationResponse; const ALanguage: string = 'en-US'): Boolean;
        [Get('/maps/api/geocode/json?latlng={ALatitude},{ALongitude}&key={ApiKey}')]
        [Headers('Accept-Language', '{ALanguage},en-US;q=0.5')]
        function TryGeolocationToAddress(const ALatitude, ALongitude: Double; out AResult: TGoogleAddressResponse; const ALanguage: string = 'en-US'): Boolean;
        function GetApiKey: string;
        procedure SetApiKey(const AValue: string);
        property ApiKey: string read GetApiKey write SetApiKey;
      end;
  strict private
    FApi: IipGoogleMapsAPI;
    FEnabled: Boolean;
    function GetApiKey: string;
    function GetEnabled: Boolean;
    procedure SetApiKey(const AValue: string);
    procedure SetEnabled(AValue: Boolean);
  {$ENDREGION}
  public
    constructor Create(const AApiKey: string = '');
    function TryAddressToGeolocation(const AAddress: string; ALanguage: TIpIdiom; out AGeolocation: TipGeolocation): TipGoogleGeocodingResult;
    function TryGeolocationToAddress(const AGeolocation: TipGeolocation; ALanguage: TipIdiom; var AStreetNumber, ARoute, ASublocality,
      ALocality, AAdministrativeArea1, ACountry, APostalCode, AFormattedAddress: string): TipGoogleGeocodingResult;
    property ApiKey: string read GetApiKey write SetApiKey;
    property Enabled: Boolean read GetEnabled write SetEnabled;
  end;

implementation

uses
  { Delphi }
  System.TypInfo;

function IdiomToCode(const AIdiom: TipIdiom): string;
begin
  case AIdiom of
    TipIdiom.English: Result := 'en';
    TipIdiom.PortugueseBrazil: Result := 'pt_BR';
  else
    Result := '';
  end;
end;

{ TipGoogleGeocoding }

constructor TipGoogleGeocoding.Create(const AApiKey: string);
begin
  inherited Create;
  FEnabled := True;
  FApi := GRestService.&For<IipGoogleMapsAPI>(nil, '', False);
  ApiKey := AApiKey;
end;

function TipGoogleGeocoding.GetApiKey: string;
begin
  Result := FApi.ApiKey;
end;

function TipGoogleGeocoding.GetEnabled: Boolean;
begin
  Result := FEnabled;
end;

procedure TipGoogleGeocoding.SetApiKey(const AValue: string);
begin
  FApi.ApiKey := AValue;
end;

procedure TipGoogleGeocoding.SetEnabled(AValue: Boolean);
begin
  FEnabled := AValue;
end;

function TipGoogleGeocoding.TryAddressToGeolocation(const AAddress: string;
  ALanguage: TIpIdiom; out AGeolocation: TipGeolocation): TipGoogleGeocodingResult;
var
  LResponse: TGoogleGeolocationResponse;
begin
  AGeolocation := TipGeolocation.Empty;
  if (not FEnabled) or ApiKey.IsEmpty then
    Exit(TipGoogleGeocodingResult.Failed);
  if not FApi.TryAddressToGeolocation(AAddress, LResponse, IdiomToCode(ALanguage)) then
    Exit(TipGoogleGeocodingResult.Failed);
  if LResponse.Status <> TStatusCode.OK then
  begin
    {$IFDEF DEBUG}
    raise EipGoogleGeocoding.CreateFmt('Failed to get the geolocation (code: %s; message: %s)', [GetEnumName(TypeInfo(TStatusCode), Ord(LResponse.Status)), LResponse.ErrorMessage]);
    {$ELSE}
    //GLogs.Error('Failed to get the geolocation (code: %s; message: %s)', [GetEnumName(TypeInfo(TStatusCode), Ord(LResponse.Status)), LResponse.ErrorMessage]);
    Exit(TipGoogleGeocodingResult.Failed);
    {$ENDIF}
  end;
  if Length(LResponse.Results) = 0 then
    Exit(TipGoogleGeocodingResult.NotFound);
  AGeolocation.Latitude := LResponse.Results[0].Geometry.Location.Latitude;
  AGeolocation.Longitude := LResponse.Results[0].Geometry.Location.Longitude;
  if AGeolocation.IsEmpty then
    Result := TipGoogleGeocodingResult.NotFound
  else
    Result := TipGoogleGeocodingResult.Success;
end;

function TipGoogleGeocoding.TryGeolocationToAddress(
  const AGeolocation: TipGeolocation; ALanguage: TipIdiom; var AStreetNumber,
  ARoute, ASublocality, ALocality, AAdministrativeArea1, ACountry, APostalCode,
  AFormattedAddress: string): TipGoogleGeocodingResult;

  function ProcessAddressComponent(const AAddressComponent: TAddressComponent): Boolean;
  var
    I: Integer;
  begin
    Result := True;
    for I := 0 to Length(AAddressComponent.Types)-1 do
    begin
      if AAddressComponent.Types[I] = 'street_number' then
        AStreetNumber := AAddressComponent.LongName
      else if AAddressComponent.Types[I] = 'route' then
        ARoute := AAddressComponent.LongName
      else if AAddressComponent.Types[I] = 'sublocality' then
        ASublocality := AAddressComponent.LongName
      else if (AAddressComponent.Types[I] = 'locality') and ALocality.IsEmpty then
        ALocality := AAddressComponent.LongName
      else if (AAddressComponent.Types[I] = 'administrative_area_level_2') and ALocality.IsEmpty then
        ALocality := AAddressComponent.LongName
      else if AAddressComponent.Types[I] = 'administrative_area_level_1' then
        AAdministrativeArea1 := AAddressComponent.ShortName
      else if AAddressComponent.Types[I] = 'country' then
        ACountry := AAddressComponent.LongName
      else if AAddressComponent.Types[I] = 'postal_code' then
        APostalCode := AAddressComponent.LongName;
    end;
  end;

  procedure ClearOutput;
  begin
    AStreetNumber := '';
    ARoute := '';
    ASublocality := '';
    ALocality := '';
    AAdministrativeArea1 := '';
    ACountry := '';
    APostalCode := '';
    AFormattedAddress := '';
  end;

var
  LResponse: TGoogleAddressResponse;
  I: Integer;
begin
  ClearOutput;
  if (not FEnabled) or ApiKey.IsEmpty then
    Exit(TipGoogleGeocodingResult.Failed);
  if not FApi.TryGeolocationToAddress(AGeolocation.Latitude, AGeolocation.Longitude, LResponse, IdiomToCode(ALanguage)) then
    Exit(TipGoogleGeocodingResult.Failed);
  if LResponse.Status <> TStatusCode.OK then
  begin
    {$IFDEF DEBUG}
    raise EipGoogleGeocoding.CreateFmt('Failed to get the address (code: %s; message: %s)', [GetEnumName(TypeInfo(TStatusCode), Ord(LResponse.Status)), LResponse.ErrorMessage]);
    {$ELSE}
    //GLogs.Error('Failed to get the address (code: %s; message: %s)', [GetEnumName(TypeInfo(TStatusCode), Ord(LResponse.Status)), LResponse.ErrorMessage]);
    Exit(TipGoogleGeocodingResult.Failed);
    {$ENDIF}
  end;
  if (Length(LResponse.Results) = 0) or (Length(LResponse.Results[0].AddressComponents) = 0) then
    Exit(TipGoogleGeocodingResult.NotFound);
  Result := TipGoogleGeocodingResult.Success;
  try
    for I := 0 to Length(LResponse.Results[0].AddressComponents)-1 do
      if not ProcessAddressComponent(LResponse.Results[0].AddressComponents[I]) then
        Exit(TipGoogleGeocodingResult.Failed);
    AFormattedAddress := LResponse.Results[0].FormattedAddress;
    if (AFormattedAddress = '') or (ACountry = '') or (AAdministrativeArea1 = '') or (ALocality = '') or (ASublocality = '') then
      Result := TipGoogleGeocodingResult.NotFound;
  finally
    if Result <> TipGoogleGeocodingResult.Success then
      ClearOutput;
  end;
end;

end.

iPub.Rtl.Geolocation.pas

unit iPub.Rtl.Geolocation;

interface

{$SCOPEDENUMS ON}

uses
  { Delphi }
  System.Types,
  System.Math;

type
  { TipGeolocation }

  TipGeolocation = packed record
  public
    const
      MathRoundTo = -6;
      MathEpsilon = 1E-6;
  private type
    T2DCoordinate = array[0..1] of Double; // Necessary for TipProtocolBuffer compatibility
  private
    procedure SetLatitude(const AValue: Double);
    procedure SetLongitude(const AValue: Double);
  public
    class function Empty: TipGeolocation; static;
    class operator Equal(const ALeft, ARight: TipGeolocation): Boolean;
    class operator NotEqual(const ALeft, ARight: TipGeolocation): Boolean;
  public
    Coordinates: T2DCoordinate; // One unique var is necessary for TipProtocolBuffer compatibility
    constructor Create(const ALatitude, ALongitude: Double);
    function DistanceInMetersTo(const AGeolocation: TipGeolocation): Double;
    function IsEmpty: Boolean;
    procedure SetEmpty;
    property Latitude: Double read Coordinates[0] write SetLatitude;
    property Longitude: Double read Coordinates[1] write SetLongitude;
  end;

implementation

{ TipGeolocation }

constructor TipGeolocation.Create(const ALatitude, ALongitude: Double);
begin
  Latitude := ALatitude;
  Longitude := ALongitude;
end;

function TipGeolocation.DistanceInMetersTo(
  const AGeolocation: TipGeolocation): Double;
const
  EARTHS_RADIUS_IN_METERS = 6378137;
var
  LDeltaLat, LDeltaLong, LA: Double;
begin
  LDeltaLat := DegToRad(AGeolocation.Latitude - Latitude);
  LDeltaLong := DegToRad(AGeolocation.Longitude - Longitude);
  LA := Sin(LDeltaLat / 2) * Sin(LDeltaLat / 2) + Cos(DegToRad(Latitude)) * Cos(DegToRad(AGeolocation.Latitude)) * Sin(LDeltaLong / 2) * Sin(LDeltaLong / 2);
  Result := Abs(EARTHS_RADIUS_IN_METERS * 2 * ArcTan2(Sqrt(LA), Sqrt(1 - LA)));
end;

class function TipGeolocation.Empty: TipGeolocation;
begin
  Result.SetEmpty;
end;

class operator TipGeolocation.Equal(const ALeft,
  ARight: TipGeolocation): Boolean;
begin
  Result := SameValue(ALeft.Latitude, ARight.Latitude, MathEpsilon) and
    SameValue(ALeft.Longitude, ARight.Longitude, MathEpsilon);
end;

function TipGeolocation.IsEmpty: Boolean;
begin
  Result := SameValue(Latitude, 0.0, MathEpsilon) and
    SameValue(Longitude, 0.0, MathEpsilon);
end;

class operator TipGeolocation.NotEqual(const ALeft,
  ARight: TipGeolocation): Boolean;
begin
  Result := (not SameValue(ALeft.Latitude, ARight.Latitude, MathEpsilon)) or
    (not SameValue(ALeft.Longitude, ARight.Longitude, MathEpsilon));
end;

procedure TipGeolocation.SetEmpty;
begin
  FillChar(Self, SizeOf(Self), #0);
end;

procedure TipGeolocation.SetLatitude(const AValue: Double);
begin
  Coordinates[0] := RoundTo(EnsureRange(AValue, -90, 90), MathRoundTo);
end;

procedure TipGeolocation.SetLongitude(const AValue: Double);
begin
  Coordinates[1] := RoundTo(EnsureRange(AValue, -180, 180), MathRoundTo);
end;

end.