注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

鑫淼梦园的博客

圆你的梦想 从这里开始

 
 
 

日志

 
 

Google Map Delphi  

2012-09-11 13:52:51|  分类: delphi xe2 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

想在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;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.

  评论这张
 
阅读(816)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017