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&v=2&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;width: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不太熟，只能随便写几句，能阐明意思，那就不错了。