DELPHI中应用GoogleMap[转]

想在DELPHI中应用GoogleMap吗,简单,费话不多说照着弄一下就明白了。
代码:
unit fMain;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, StdCtrls,
  ComCtrls, IdTCPConnection, IdTCPClient, IdHTTP, IdURI, ExtCtrls, IdBaseComponent, IdComponent;
type
  TfrmMain = class(TForm)
    WebBrowser1: TWebBrowser;
    btnAddMarker: TButton;
    StatusBar1: TStatusBar;
    btnGeocode: TButton;
    IdHTTP1: TIdHTTP;
    leLat: TLabeledEdit;
    leLng: TLabeledEdit;
    mmGeocode: TMemo;
    btnCenterMap: TButton;
    rbAPI: TRadioButton;
    rbCheat: TRadioButton;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnAddMarkerClick(Sender: TObject);
    procedure btnCenterMapClick(Sender: TObject);
    procedure btnGeocodeClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    procedure geocode(const s: String; out lat, lng: String);
    procedure geocodeCheat(const s: String; out lat, lng: String);
  public
    { Public declarations }
  end;
var
  frmMain: TfrmMain;
implementation
uses
   MSHTML, StrUtils, ActiveX;
const
   GOOGLE_MAPS_API_KEY = 'ABQIAAAAvrcNJEwrVo4hA_8eyQbk5BRuDRFc5_CuEQVEx-1xcZw7XTzD5hSiKWzRiiKVCLnPDSEF5x9j0zEK_g';
{$R *.dfm}
const
   rootDoc: String =
'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'
             +'"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'#13
             +'<html xmlns="http://www.w3.org/1999/xhtml" xmlns:v="urn:schemas-microsoft-com:vml">'#13
             +'<head>'#13
             +'<meta http-equiv="content-type" content="text/html; charset=utf-8"/>'#13
             +'<title>Google Maps JavaScript API Example: Simple Map</title>'#13
             +'<script src="http://maps.google.com/maps?file=api&amp;v=2&amp;key="'#13
             +'type="text/javascript"></script>'#13
             +'<script type="text/javascript">'#13
             +'var map;'
             +'function initialize() {'#13
             +'if (GBrowserIsCompatible()) {'#13
             +'map = new GMap2(document.getElementById("map_canvas"));'#13
             +'map.addControl(new GLargeMapControl());'#13
             +'map.addControl(new GMapTypeControl());'#13
             +'map.addControl(new GScaleControl());'#13
             +'map.addControl(new GOverviewMapControl());'#13
             +'map.setCenter(new GLatLng(31.573636,107.112648, 12, G_NORMAL_MAP));'#13
             +'map.enableContinuousZoom();'
             +'map.enableScrollWheelZoom();'
             +'  }'#13
             +' };'#13
             +'function createMarker(point, number) {'#13
             +'  var marker = new GMarker(point);'#13
             +'  var message = ["这","是","个","秘密","消息"];'#13
             +'marker.value = number;'#13
             +'  GEvent.addListener(marker, "click", function() {'#13
             +'    var myHtml = "<b>#" + number + "</b><br/>" + message[number -1];'#13
             +'    map.openInfoWindowHtml(point, myHtml);'#13
             +'   });'#13
             +'  return marker;'#13
             +'}'#13
             +'function showrandommarker(count){'
             +'var bounds = map.getBounds();'
             +'var southWest = bounds.getSouthWest();'
             +'var northEast = bounds.getNorthEast();'
             +'var lngSpan = northEast.lng() - southWest.lng();'
             +'var latSpan = northEast.lat() - southWest.lat();'
             +'for (var i = 0; i < count; i++) {'
             +'  var point = new GLatLng(southWest.lat() + latSpan * Math.random(), southWest.lng() + lngSpan * Math.random());'
             +'  map.addOverlay(createMarker(point, i + 1));'
             +'}}'
             +'function addployline(){'
             +'  var polyline = new GPolyline([new GLatLng(39.907,116.387), new GLatLng(39.935,126.407), new GLatLng(49.935,126.407)], "#ff0000", 3);'
            +'  map.addOverlay(polyline);'
             +'}'
             +'</script>'#13
             +'</head>'#13
             +'<body onload="initialize()" onunload="GUnload()">'#13
             +'<div id="map_canvas" style="position:absolute;left:0;top:0;100%;height:100%;"></div>'#13
             +'</body>'#13
             +'</html>'#13 ;
   function doURLEncode(const S: string; const InQueryString: Boolean = true): string;
   var
     Idx: Integer; // loops thru characters in string
   begin
     Result := '';
     for Idx := 1 to Length(S) do
     begin
       case S[Idx] of
         'A'..'Z', 'a'..'z', '0'..'9', '-', '_', '.', ',':
           Result := Result + S[Idx];
         ' ':
           if InQueryString then
             Result := Result + '+'
           else
             Result := Result + '%20';
         else
           Result := Result + '%' + SysUtils.IntToHex(Ord(S[Idx]), 2);
       end;
     end;
   end;
procedure TfrmMain.FormCreate(Sender: TObject);
   procedure WBLoadHTML(WebBrowser: TWebBrowser; HTMLCode: string) ;
   var
      sl: TStringList;
      ms: TMemoryStream;
   begin
      WebBrowser.Navigate('about:blank') ;
      // pretend we're at localhost, so google doesn't complain about the API key
      (WebBrowser.Document as IHTMLDocument2).URL := 'http://localhost/';
      while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do
         Application.ProcessMessages;
      if Assigned(WebBrowser.Document) then
      begin
         sl := TStringList.Create;
         try
            ms := TMemoryStream.Create;
            try
               sl.Text := HTMLCode;
               sl.SaveToStream(ms);
               ms.Seek(0, 0);
               (WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms));
            finally
               ms.Free;
            end;
         finally
            sl.Free;
         end;
      end;
   end;
begin
   WBLoadHTML(WebBrowser1, rootDoc);
end;
procedure TfrmMain.geocode(const s: String; out lat, lng: String);
var
   address, resp: String;
   p1, p2: Integer;
begin
   address := StringReplace(StringReplace(Trim(s), #13, ' ', [rfReplaceAll]), #10, ' ', [rfReplaceAll]);
   address := doURLEncode(address);
   address := 'http://maps.google.com/maps/geo?q=' + address;
   address := TIDUri.UrlEncode(address + '&output=csv&key=' + GOOGLE_MAPS_API_KEY);
   // if you want more info, try output=JSON or output=xml, etc.
   resp := IdHTTP1.Get(address);
   // resp = StatusCode,Accuracy,Lat,Lng
   p1 := Pos(',', resp);
   p1 := PosEx(',', resp, p1+1);
   p2 := PosEx(',', resp, p1+1);
   // p1 is at the comma before Lat, p2 is at the comma before Lng
   lat := Copy(resp, p1+1, p2 - p1 - 1);
   lng := Copy(resp, p2+1, Length(resp) - p2);
end;
procedure TfrmMain.geocodeCheat(const s: String; out lat, lng: String);
const
   VIEWPORT: String = 'viewport:{center:{';
var
   address, strResponse, latlng, st: String;
   pStart, pEnd: Integer;
   ts: TStringList;
begin
   // Cheat at geocoding, retrieve the page that google responds with, as if we entered the text in the search box
   /// response (currently) contains this sort of thing:
   ///   viewport:{center:{lat:40.886159999999997,lng:-73.366669999999999}
   address := StringReplace(StringReplace(Trim(s), #13, ' ', [rfReplaceAll]), #10, ' ', [rfReplaceAll]);
   address := doURLEncode(address);
   address := 'http://maps.google.com/maps?q=' + address;
   address := TIDUri.UrlEncode(address + '&output=csv'); // I don't know exactly why the &output=csv helps
                                                         // it was from a previous URL,
                                                         // but without it, I get error 302 - Found.
                                                         // which is rather odd.
   strResponse := IdHTTP1.Get(address);
   pStart := Pos(VIEWPORT, strResponse);
   pEnd := PosEx('}', strResponse, pStart + 1);
   if (pStart < 1) or (pEnd < 1) then
      raise Exception.Create('I think google changed the html, this is a problem.');
   pStart := pStart + Length(VIEWPORT);
   latlng := Copy(strResponse, pStart, pEnd - pStart);
   ts := TStringList.Create;
   try
      ts.LineBreak := ',';
      ts.Text := latlng;
      for st in ts do
      begin
         if Pos('lat:', st) = 1 then
         begin
            lat := Copy(st, 5, Length(st) - 5);
         end
         else if Pos('lng:', st) = 1 then
         begin
            lng := Copy(st, 5, Length(st) - 5);
         end;
      end;
   finally
      ts.Free;
   end;
end;
procedure TfrmMain.btnAddMarkerClick(Sender: TObject);
var
   Doc2: IHTMLDocument2;
   Win2: IHTMLWindow2;
   latlng,Script: String;
begin
   Doc2 := WebBrowser1.Document as IHTMLDocument2;
   Win2 := Doc2.parentWindow;
   latlng := format('%s,%s',[leLat.Text,leLng.Text]);
   // no callback or anything, just a visual representation for proof of concept.
   Script := 'map.addOverlay( new GMarker(new GLatLng(' + latlng + ')) );';
//   Script := 'showrandommarker(5)';
//   WebBrowser1.OleObject.document.parentWindow.execScript(Script,'JavaScript');
   Win2.execScript(Script, 'JavaScript');
end;
procedure TfrmMain.btnCenterMapClick(Sender: TObject);
var
   Doc2: IHTMLDocument2;
   Win2: IHTMLWindow2;
   latlng: String;
begin
   Doc2 := WebBrowser1.Document as IHTMLDocument2;
   Win2 := Doc2.parentWindow;
   latlng := '"' + leLat.Text + '", "' + leLng.Text + '"';
   Win2.execScript('map.panTo(new GLatLng(' + latlng + '));', 'JavaScript');
end;
procedure TfrmMain.btnGeocodeClick(Sender: TObject);
var
   latitude, longitude: String;
begin
   if rbAPI.Checked then
      geocode(mmGeocode.Lines.Text, latitude, longitude)
   else if rbCheat.Checked then
      geocodeCheat(mmGeocode.Lines.Text, latitude, longitude);
   leLat.Text := latitude;
   leLng.Text := longitude;
end;
procedure TfrmMain.Button1Click(Sender: TObject);
var
   Doc2: IHTMLDocument2;
   Win2: IHTMLWindow2;
   latlng: String;
begin
   Doc2 := WebBrowser1.Document as IHTMLDocument2;
   Win2 := Doc2.parentWindow;
   Win2.execScript('addployline();','JavaScript');
end;
end.
窗体:
object frmMain: TfrmMain
  Left = 0
  Top = 0
  Caption = 'GoogleMaps in Delphi'
  ClientHeight = 455
  ClientWidth = 757
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  DesignSize = (
    757
    455)
  PixelsPerInch = 96
  TextHeight = 13
  object WebBrowser1: TWebBrowser
    Left = 8
    Top = 8
    Width = 610
    Height = 422
    Anchors = [akLeft, akTop, akRight, akBottom]
    TabOrder = 8
    ControlData = {
      4C0000000C3F00009D2B00000000000000000000000000000000000000000000
      000000004C000000000000000000000001000000E0D057007335CF11AE690800
      2B2E126208000000000000004C0000000114020000000000C000000000000046
      8000000000000000000000000000000000000000000000000000000000000000
      00000000000000000100000000000000000000000000000000000000}
  end
  object btnAddMarker: TButton
    Left = 624
    Top = 232
    Width = 125
    Height = 25
    Anchors = [akTop, akRight]
    Caption = 'Add Marker'
    TabOrder = 6
    OnClick = btnAddMarkerClick
  end
  object StatusBar1: TStatusBar
    Left = 0
    Top = 436
    Width = 757
    Height = 19
    Panels = <>
    SimplePanel = True
  end
  object btnGeocode: TButton
    Left = 624
    Top = 55
    Width = 125
    Height = 25
    Anchors = [akTop, akRight]
    Caption = 'Geocode'
    TabOrder = 1
    OnClick = btnGeocodeClick
  end
  object leLat: TLabeledEdit
    Left = 624
    Top = 144
    Width = 125
    Height = 21
    Anchors = [akTop, akRight]
    EditLabel.Width = 39
    EditLabel.Height = 13
    EditLabel.Caption = 'Latitude'
    TabOrder = 4
    Text = '30.521469'
  end
  object leLng: TLabeledEdit
    Left = 624
    Top = 184
    Width = 125
    Height = 21
    Anchors = [akTop, akRight]
    EditLabel.Width = 47
    EditLabel.Height = 13
    EditLabel.Caption = 'Longitude'
    TabOrder = 5
    Text = '107.112648'
  end
  object mmGeocode: TMemo
    Left = 624
    Top = 8
    Width = 126
    Height = 41
    Anchors = [akTop, akRight]
    Lines.Strings = (
      'Rego Park, NY')
    TabOrder = 0
  end
  object btnCenterMap: TButton
    Left = 624
    Top = 263
    Width = 125
    Height = 25
    Anchors = [akTop, akRight]
    Caption = 'Center map on'
    TabOrder = 7
    OnClick = btnCenterMapClick
  end
  object rbAPI: TRadioButton
    Left = 624
    Top = 88
    Width = 33
    Height = 17
    Hint = 'The "correct" way to do it'
    Anchors = [akTop, akRight]
    Caption = 'API'
    Checked = True
    ParentShowHint = False
    ShowHint = True
    TabOrder = 2
    TabStop = True
  end
  object rbCheat: TRadioButton
    Left = 680
    Top = 88
    Width = 49
    Height = 17
    Hint = 'Seems to be more accurate'
    Anchors = [akTop, akRight]
    Caption = 'Cheat'
    ParentShowHint = False
    ShowHint = True
    TabOrder = 3
  end
  object Button1: TButton
    Left = 624
    Top = 296
    Width = 125
    Height = 25
    Anchors = [akTop, akRight]
    Caption = 'AddPloyLine'
    TabOrder = 10
    OnClick = Button1Click
  end
  object IdHTTP1: TIdHTTP
    AllowCookies = True
    ProxyParams.BasicAuthentication = False
    ProxyParams.ProxyPort = 0
    Request.ContentLength = -1
    Request.Accept = 'text/html, */*'
    Request.BasicAuthentication = False
    Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)'
    HTTPOptions = [hoForceEncodeParams]
    Left = 704
    Top = 400
  end
end
试用运行一下,一般没问题,有问题的话就要加入Google Map Key了,网上这方面介绍的有很多的。
说一下原理:在html中声明了一个 var map;是一个全局的对象,下面的几个方法都是对这个对象进行操作,俺JaveScript不太熟,只能随便写几句,能阐明意思,那就不错了。

原文地址:https://www.cnblogs.com/delphi7456/p/1895950.html