zoukankan      html  css  js  c++  java
  • 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不太熟,只能随便写几句,能阐明意思,那就不错了。

  • 相关阅读:
    jpa入门案例----使用jpa对数据库进行查询、删除、修改操作
    ssm详细流程和步骤
    Dubbo
    ssm运行BUG
    mybatis 入门
    Linux
    Redis
    maven
    三层架构 开发模式
    转发和重定向的区别
  • 原文地址:https://www.cnblogs.com/delphi7456/p/1895950.html
Copyright © 2011-2022 走看看