教程-Delphi调用百度地图API(XE8+WIN7)
2024-10-21 16:09:46
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.
最新文章
- 【SQLServer】DBHelper即Ｃ＃数据库底层封装
- JavaScript笔记:函数
- 使用my exclipse对数据库进行操作(3)
- css: 照片有如层叠效果
- 设置h5页面不可复制文字
- Android 对 properties文件的读写操作
- 20160201.CCPP体系详解(0011天)
- 如何将一个IP地址移出PBL，不然，国内邮件服务器不能正常发送国外邮件哟。
- 修改hosts使用谷歌服务
- Swift - 10 - assert(断言)
- 前端MVVM学习之KnockOut(二)
- MPreview.js
- ElasticSearch 学习记录之ES查询添加排序字段和使用missing或existing字段查询
- C#使用Gecko实现浏览器
- Spring的由来以及发展
- 蓝牙协议分析(6)_BLE地址类型
- canvas-star1.html
- 2017-2018-1 20155228 《信息安全系统设计基础》第六周学习总结&课下作业
- 一台老服务器的升级日志（PHP4.4.9+MySQL5.1）升级MySQL5.6
- 16.网络《果壳中的c#》