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不太熟,只能随便写几句,能阐明意思,那就不错了。

  • 相关阅读:
    如何在Ubuntu Server 18.04上安装Microsoft的Procmon
    如何在Ubuntu 20.04上安装Wine 5.0
    如何在Kali Linux 2020中启用SSH服务
    如何在Ubuntu 20.04 LTS Focal Fossa上安装Apache Groovy
    如何使用命令在Ubuntu 20.04 Linux上安装Vmware Tools
    在Ubuntu 20.04 LTS Focal Fossa上安装Zabbix Agent
    hdu 2089 不要62
    hdu 2093 成绩排名
    hdu 2104 hide handkerchief
    leetcode147对链表进行插入排序
  • 原文地址:https://www.cnblogs.com/delphi7456/p/1895950.html
Copyright © 2011-2022 走看看