教程-Delphi调用百度地图API(XE8+WIN7)

unit U_map;

interface

//---------------------------------------------------//

//----------COPY BY 无言 QQ:4252181 -----------------//

//---------------------------------------------------//

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, OleCtrls, SHDocVw, StdCtrls, MSHTML, StrUtils, ActiveX,

  ExtCtrls;

//---------------------------------------------------//

//----------欢迎大家和我联系，软件开发 --------------//

//---------------------------------------------------//

type

  TF_map = class(TForm)

    grp1: TGroupBox;

    WebBrowser: TWebBrowser;

    grp2: TGroupBox;

    grp3: TGroupBox;

    grp4: TGroupBox;

    tmr1: TTimer;

    GroupBox1: TGroupBox;

    GroupBox2: TGroupBox;

    Edit1: TEdit;

    Edit2: TEdit;

    chk1: TCheckBox;

    Edit3: TEdit;

    Edit4: TEdit;

    edt1: TEdit;

    edt2: TEdit;

    edt3: TEdit;

    edt4: TEdit;

    procedure FormCreate(Sender: TObject);

    procedure btn1Click(Sender: TObject);

    procedure btn2Click(Sender: TObject);

    procedure FormShow(Sender: TObject);

    procedure btn3Click(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure loadweb();

    procedure btn4Click(Sender: TObject);

    procedure AppMsg(var Msg: TagMsg; var Handled: Boolean);

    procedure GetWebContent();

    procedure tmr1Timer(Sender: TObject);

  private

    { Private declarations }

    lng, lat: string;

  public

    { Public declarations }

  end;

var

  F_map: TF_map;

  const

  Doc1: string = '<html>'

  + '<head>'

  + '<meta name="viewport" content="initial-scale=1.0, user-scalable=no" />'

  + '<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />'

  + '<title>BAIDU MAP</title>'

  + '<style type="text/css">'

  + 'html{height:100%}' + 'body{height:100%;margin:0px;padding:0px}'

  + '#container{height:100%}'

  + '</style>'

  + '<script type="text/javascript"src="http://api.map.baidu.com/api?v=1.3"></script>'

  + '</head>'

  + '<body>'

  + '<div id="container"></div>'

  //style="visibility:hidden; display:none">

  +'<div id="centerweidu" style="visibility:hidden; display:none"></div>'

  +'<div id="centerjingdu" style="visibility:hidden; display:none"></div>'

  +'<div id="weidutemp" style="visibility:hidden;display:none"></div>'

  +'<div id="jingdutemp" style="visibility:hidden;display:none"></div>'

  +'<div id="weidu" style="visibility:hidden;display:none"></div>'

  +'<div id="jingdu" style="visibility:hidden;display:none"></div>'

  +'<div id="Distance" style="visibility:hidden;display:none"></div>'

  + '<script language="JavaScript" type="text/javascript">'

  + 'var map = new BMap.Map("container");'  // 创建地图实例

  + 'map.addControl(new BMap.NavigationControl());'

  + 'map.addControl(new BMap.ScaleControl());'

  + 'map.addControl(new BMap.OverviewMapControl());'

  + 'map.addControl(new BMap.MapTypeControl(BMAP_ANCHOR_BOTTOM_RIGHT));'   // 将标注添加到地图中

  + 'map.enableScrollWheelZoom();'                  // 启用滚轮放大缩小。

  + 'map.enableKeyboard();'                         // 启用键盘操作。

  + 'var centerpoint = new BMap.Point(126.666431,45.764502);' // 创建点坐标  126.666431, 45.764502

  + 'var marker = new BMap.Marker(centerpoint);'        // 创建标注

  + 'map.addOverlay(marker);'

  + 'var label = new BMap.Label("哈尔滨海铭科技有限公司",{offset:new BMap.Size(20,-10)});'

  + 'marker.setLabel(label);'

  +' map.centerAndZoom(centerpoint, 15);' // 初始化地图，设置中心点坐标和地图级别'

  +' map.addEventListener("mousemove", function(e){'

  +' document.getElementById("weidutemp").innerHTML = e.point.lng;'

  +' document.getElementById("jingdutemp").innerHTML =  e.point.lat;});'

  +' map.addEventListener("click", function(f){'

  +' document.getElementById("weidu").innerHTML = f.point.lng;'

  +' document.getElementById("jingdu").innerHTML =  f.point.lat;});'

  +'function SetCarCenterPoint(newlng,newlat){'

  +'centerpoint=new BMap.Point(newlng,newlat);'

  + 'var marker = new BMap.Marker(centerpoint);'

  + 'map.addOverlay(marker);'

  + 'var label = new BMap.Label("当前汽车坐标",{offset:new BMap.Size(20,-10)});'

  + 'marker.setLabel(label);'

  + 'map.panTo(centerpoint);'

  +'}'

  +'function SetAutoCenterPoint(newlng,newlat){'

  +'centerpoint=new BMap.Point(newlng,newlat);'

  + 'var marker = new BMap.Marker(centerpoint);'

  + 'map.addOverlay(marker);'

  + 'var label = new BMap.Label("4S店坐标",{offset:new BMap.Size(20,-10)});'

  + 'marker.setLabel(label);'

  + 'map.panTo(centerpoint);'

  +'}'

  +'function PrintLine(newlng,newlat,oldlng,oldlat,biaoji){'

  +'var point = new BMap.Point(newlng,newlat);' // 创建点坐标

  + 'map.panTo(point);'

//  + 'if (biaoji=''0'')'

//  +'{'

//  + 'var marker = new BMap.Marker(point);'

//  + 'map.addOverlay(marker);'

//  +'}'

  + 'var polyline = new BMap.Polyline(['

  + 'new BMap.Point(oldlng,oldlat),'

  + 'new BMap.Point(point.lng, point.lat)'

  + '], {strokeColor:"blue", strokeWeight:4, strokeOpacity:0.5});'

  + 'map.addOverlay(polyline);'

  +'}'

  +'function GetCenter(){'

  +' var center = map.getCenter();'

  +' document.getElementById("centerweidu").innerHTML = center.lng;'

  +' document.getElementById("centerjingdu").innerHTML = center.lat;'

  +'}'

  +'function Distance(newlng,newlat){'

  +'var pointA=centerpoint;'

  +'var pointB=new BMap.Point(newlng,newlat);'

  +'document.getElementById("Distance").innerHTML = map.getDistance(pointA,pointB);'

  +'alert(''距离是：''+map.getDistance(pointA,pointB)+'' 米。'');'

 // +'return map.getDistance(pointA,pointB);'

  +'}'

  + '</script>'

  + '</body>'

  + '</html>';

implementation

{$R *.dfm}

procedure TF_map.AppMsg(var Msg: TagMsg; var Handled: Boolean);

var

  mPoint: TPoint;

begin

  if IsChild(WebBrowser.Handle, Msg.Hwnd) and (Msg.Message = WM_MOUSEMOVE) then

  begin

    GetCursorPos(mPoint);

    GetWebContent;

    Handled := True;

  end;

end;

function JavaScript(j: string): Boolean;

begin

  try

    // (F_map.WebBrowser.Document as IHTMLDocument2).parentWindow.execScript(j, 'JavaScript');

    F_map.WebBrowser.OleObject.Document.parentWindow.execScript(j,

      'JavaScript');

    Result := True;

  except

    Result := false;

  end;

end;

procedure TF_map.btn1Click(Sender: TObject);

var

  str: string;

begin

  self.WebBrowser.OleObject.Document.parentWindow.execScript('GetCenter()',

    'JavaScript');

end;

procedure TF_map.btn2Click(Sender: TObject);

var

  str: string;

begin

  if (Edit1.Text <> '') and (Edit2.Text <> '') then

  begin

    self.WebBrowser.OleObject.Document.parentWindow.execScript

      ('Distance(' + Edit1.Text + ',' + Edit2.Text + ')', 'JavaScript');

  end;

end;

procedure TF_map.btn3Click(Sender: TObject);

var

  biaoji: string;

begin

  if lng = '' then

  begin

    lng := '126.666431'; // 126.666431,45.764502

  end;

  if lat = '' then

  begin

    lat := '45.764502';

  end;

  if chk1.Checked then

  begin

    biaoji := '';

  end

  else

  begin

    biaoji := '';

  end;

  if (Edit1.Text <> '') and (Edit2.Text <> '') then

  begin

    self.WebBrowser.OleObject.Document.parentWindow.execScript

      ('PrintLine(' + Edit1.Text + ',' + Edit2.Text + ',' + lng + ',' + lat +

        ',' + biaoji + ')', 'JavaScript');

    lng := self.Edit1.Text;

    lat := self.Edit2.Text;

  end;

end;

procedure TF_map.btn4Click(Sender: TObject);

begin

  loadweb;

  lng := '';

  lat := '';

end;

procedure TF_map.Button1Click(Sender: TObject);

var

  str: string;

begin

  if (Edit3.Text <> '') and (Edit4.Text <> '') then

  begin

    self.WebBrowser.OleObject.Document.parentWindow.execScript

      ('SetAutoCenterPoint(' + Edit3.Text + ',' + Edit4.Text +

        ')', 'JavaScript');

  end;

end;

procedure TF_map.loadweb();

var

  sl: TStringList;

  ms: TMemoryStream;

begin

  self.WebBrowser.Silent := True;

  WebBrowser.Navigate('about:blank'); (WebBrowser.Document as IHTMLDocument2)

  .URL := 'http://127.0.0.1/';

  while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do

    Application.ProcessMessages;

  if Assigned(WebBrowser.Document) then

  begin

    sl := TStringList.Create;

    try

      ms := TMemoryStream.Create;

      try

        sl.Text := Doc1;

        sl.SaveToStream(ms);

        ms.Seek(, ); (WebBrowser.Document as IPersistStreamInit)

        .Load(TStreamAdapter.Create(ms));

      finally

        ms.Free;

      end;

    finally

      sl.Free;

    end;

  end;

end;

procedure TF_map.tmr1Timer(Sender: TObject);

begin

  GetWebContent;

end;

procedure TF_map.FormCreate(Sender: TObject);

begin

  loadweb;

  //Application.OnMessage:=AppMsg;

end;

procedure TF_map.FormShow(Sender: TObject);

begin

  lng := '';

  lat := '';

  tmr1.Enabled := True;

end;

procedure TF_map.GetWebContent();

var

  html: IHTMLDocument2; // 定义网页元素

  submitbutton: OleVariant; // 定义按钮

  centerweidu, centerjingdu, weidu, jingdu, weidutemp,

    jingdutemp: IHTMLElement; // 定义网页输入元素

begin

  try

    html := self.WebBrowser.Document as IHTMLDocument2;

    centerweidu := html.all.item('centerweidu', ) as IHTMLElement;

    centerjingdu := html.all.item('centerjingdu', ) as IHTMLElement;

    weidu := html.all.item('weidu', ) as IHTMLElement;

    jingdu := html.all.item('jingdu', ) as IHTMLElement;

    weidutemp := html.all.item('weidutemp', ) as IHTMLElement;

    jingdutemp := html.all.item('jingdutemp', ) as IHTMLElement;

    edt1.Text := centerweidu.innerText;

    edt2.Text := centerjingdu.innerText;

    edt3.Text := weidutemp.innerText;

    edt4.Text := jingdutemp.innerText;

    Edit1.Text := weidu.innerText;

    Edit2.Text := jingdu.innerText;

  except

  end;

end;

end.

教程-Delphi调用百度地图API(XE8+WIN7)的更多相关文章

delphi 调用百度地图api
一.调用javascript的方法两种: 第一种:采用自编函数的方法 function ExecuteJavaScript(WebBrowser:TWebBrowser; Code: string) ...
调用百度地图Api实现的查看地图功能的小插件
1. 功能 bMap.js 可根据地理位置调用出百度地图,采用弹出框形式 2.用法 var city = '青岛市'; var address = '香港中路'; bMap.init({ city : ...
【c#】Form调用百度地图api攻略及常见问题
首先,在Form中调用百度地图api,我们需要使用webbrowser控件,这个在前面的文章中已经讲过了,可以参照(http://blog.csdn.net/buptgshengod/article/ ...
HTML5调用百度地图API获取当前位置并直接导航目的地的方法
<!DOCTYPE html> <html lang="zh-cmn-Hans"> <meta charset="UTF-8&quo ...
HTML5 调用百度地图API地理定位
<!DOCTYPE html> <html> <title>HTML5 HTML5 调用百度地图API地理定位实例</title> <head&g ...
跨平台移动开发_PhoneGap 使用Geolocation基于所在地理位置坐标调用百度地图API
使用Geolocation基于所在地理位置坐标调用百度地图API 效果图示例代码 <!DOCTYPE html> <html> <head> <title& ...
HTML5调用百度地图API进行地理定位实例
自从HTML5的标准确定以后,越来越多的网站使用HTML5来进行开发.虽然对HTML5支持的浏览器不是很多,但是依然抵挡不了大伙对HTML5开发的热情.今天为大家带来的是使用HTML5调用百度地图AP ...
HTML5页面直接调用百度地图API,获取当前位置，直接导航目的地
<!DOCTYPE html> <html lang="zh-cmn-Hans"> <meta charset="UTF-8"&g ...
调用百度地图API的总结
因为项目要用到百度地图,所以先摸索了一下,各种功能官方都有文档,点击可查看,文章的话我就直接写我用到的功能例子了,要用可以直接复制粘贴~ 一.主要涉及到的几个接口(先申请密钥): 1.技术一:坐标转换 ...

随机推荐

express + mongodb 搭建一个简易网站（三）
express + mongodb 搭建一个简易网站 (三) 前面已经实现了基本的网站功能,现在我们就开始开搞一个完整的网站,现在整个网站的UI就是下面的这个样子. 我们网站的样子就照着这个来吧. 1 ...
jquery parents用法
之前一直用find 现在用parents var w = $("div"); w = $("div").parents('.class'); //在Parent ...
spring jpa exists
Subquery<A> subquery = criteriaQuery.subquery(A.class);Root<A> root1 = subquery.from(A.c ...
亲, 我们来再重申一遍"=="和"equals的区别
今天经历的一个事情太丢脸了, 一个学弟向我请教问题, 是这样的: 一个字符串里面含有空格, 不允许使用.trim()和replace方法, 只用if和for将空格去掉, 题目很简单, 一开始我是这样写 ...
sibling
sibling 英 ['sɪblɪŋ] 美 ['sɪblɪŋ] 名词. 兄,弟,姐,妹网络. 兄弟,兄弟姐妹,同胞变形. 复数:siblings
利用redis完成自动补全搜索功能（三）
前面已经完成了分词和自动提示功能,最后把搜索结合在一起,来个完成的案例.当然最好还是用搜索分词解决,这个只是一个临时解决方案. 其实加上搜索很简单,要做的就是3件事 1. 分词的时候,把有用词的id存 ...
php多进程中的阻塞与非阻塞
我们通过pcntl_fork来创建子进程,使用pcntl_wait和pcntl_waitpid来回收子进程. 子进程退出后,父进程没有及时回收,就会产生僵尸进程. 例1: <?php def ...
对FPKM/RPKM以及TPM的理解
对FPKM/RPKM以及TPM的理解 2018年07月03日 16:05:53 sixu_9days 阅读数:559 标签: FPKM/RPKMTPMRNA-Seq 更多个人分类: RNA-Seq ...
HDFS高可用性及其分布式系统思想基础
源自单点失效问题,也就是当NameNode不可用的时候,用什么办法可以平滑过渡? 最直接的办法是再添加一个备用的NN,这就产生了Active NameNode和Standby NameNode的设计思 ...
Java数据结构和算法（二）顺序存储的树结构
Java数据结构和算法(二)顺序存储的树结构数据结构与算法目录(https://www.cnblogs.com/binarylei/p/10115867.html) 二叉树也可以用数组存储,可以和完 ...

教程-Delphi调用百度地图API(XE8+WIN7)

教程-Delphi调用百度地图API(XE8+WIN7)的更多相关文章

随机推荐

热门专题