相关资料:
无言 QQ:4252181
实例代码：
1 unit U_map; 2 3 interface 4 //---------------------------------------------------// 5 //----------COPY BY 无言 QQ:4252181 -----------------// 6 //---------------------------------------------------// 7 uses 8 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 9 Dialogs, OleCtrls, SHDocVw, StdCtrls, MSHTML, StrUtils, ActiveX, 10 ExtCtrls; 11 //---------------------------------------------------// 12 //----------欢迎大家和我联系，软件开发 --------------// 13 //---------------------------------------------------// 14 type 15 TF_map = class(TForm) 16 grp1: TGroupBox; 17 WebBrowser: TWebBrowser; 18 grp2: TGroupBox; 19 grp3: TGroupBox; 20 grp4: TGroupBox; 21 tmr1: TTimer; 22 GroupBox1: TGroupBox; 23 GroupBox2: TGroupBox; 24 Edit1: TEdit; 25 Edit2: TEdit; 26 chk1: TCheckBox; 27 Edit3: TEdit; 28 Edit4: TEdit; 29 edt1: TEdit; 30 edt2: TEdit; 31 edt3: TEdit; 32 edt4: TEdit; 33 procedure FormCreate(Sender: TObject); 34 procedure btn1Click(Sender: TObject); 35 procedure btn2Click(Sender: TObject); 36 procedure FormShow(Sender: TObject); 37 procedure btn3Click(Sender: TObject); 38 procedure Button1Click(Sender: TObject); 39 procedure loadweb(); 40 procedure btn4Click(Sender: TObject); 41 procedure AppMsg(var Msg: TagMsg; var Handled: Boolean); 42 procedure GetWebContent(); 43 procedure tmr1Timer(Sender: TObject); 44 private 45 { Private declarations } 46 lng, lat: string; 47 public 48 { Public declarations } 49 end; 50 51 var 52 F_map: TF_map; 53 const 54 Doc1: string = '' 55 + '' 56 + ' ' 57 + ' ' 58 + 'BAIDU MAP ' 59 + '' 63 + '' 64 + '' 65 + '' 66 + ' ' 67 //style="visibility:hidden; display:none"> 68 +' ' 69 +' ' 70 +' ' 71 +' ' 72 +' ' 73 +' ' 74 +' ' 75 + ''143 + ''144 + '';145 implementation146 147 { $R *.dfm}148 149 procedure TF_map.AppMsg(var Msg: TagMsg; var Handled: Boolean);150 var151 mPoint: TPoint;152 begin153 if IsChild(WebBrowser.Handle, Msg.Hwnd) and (Msg.Message = WM_MOUSEMOVE) then154 begin155 GetCursorPos(mPoint);156 GetWebContent;157 Handled := True;158 end;159 end;160 161 function JavaScript(j: string): Boolean;162 begin163 try164 // (F_map.WebBrowser.Document as IHTMLDocument2).parentWindow.execScript(j, 'JavaScript');165 F_map.WebBrowser.OleObject.Document.parentWindow.execScript(j,166 'JavaScript');167 Result := True;168 except169 Result := false;170 end;171 end;172 173 procedure TF_map.btn1Click(Sender: TObject);174 var175 str: string;176 begin177 self.WebBrowser.OleObject.Document.parentWindow.execScript('GetCenter()',178 'JavaScript');179 end;180 181 procedure TF_map.btn2Click(Sender: TObject);182 var183 str: string;184 begin185 if (Edit1.Text <> '') and (Edit2.Text <> '') then186 begin187 self.WebBrowser.OleObject.Document.parentWindow.execScript188 ('Distance(' + Edit1.Text + ',' + Edit2.Text + ')', 'JavaScript');189 end;190 end;191 192 procedure TF_map.btn3Click(Sender: TObject);193 var194 biaoji: string;195 begin196 if lng = '' then197 begin198 lng := '126.666431'; // 126.666431,45.764502199 end;200 if lat = '' then201 begin202 lat := '45.764502';203 end;204 if chk1.Checked then205 begin206 biaoji := '1';207 end208 else209 begin210 biaoji := '0';211 end;212 if (Edit1.Text <> '') and (Edit2.Text <> '') then213 begin214 self.WebBrowser.OleObject.Document.parentWindow.execScript215 ('PrintLine(' + Edit1.Text + ',' + Edit2.Text + ',' + lng + ',' + lat +216 ',' + biaoji + ')', 'JavaScript');217 lng := self.Edit1.Text;218 lat := self.Edit2.Text;219 end;220 end;221 222 procedure TF_map.btn4Click(Sender: TObject);223 begin224 loadweb;225 lng := '';226 lat := '';227 end;228 229 procedure TF_map.Button1Click(Sender: TObject);230 var231 str: string;232 begin233 if (Edit3.Text <> '') and (Edit4.Text <> '') then234 begin235 self.WebBrowser.OleObject.Document.parentWindow.execScript236 ('SetAutoCenterPoint(' + Edit3.Text + ',' + Edit4.Text +237 ')', 'JavaScript');238 end;239 end;240 241 procedure TF_map.loadweb();242 var243 sl: TStringList;244 ms: TMemoryStream;245 begin246 self.WebBrowser.Silent := True;247 WebBrowser.Navigate('about:blank'); (WebBrowser.Document as IHTMLDocument2)248 .URL := 'http://127.0.0.1/';249 while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do250 Application.ProcessMessages;251 if Assigned(WebBrowser.Document) then252 begin253 sl := TStringList.Create;254 try255 ms := TMemoryStream.Create;256 try257 sl.Text := Doc1;258 sl.SaveToStream(ms);259 ms.Seek(0, 0); (WebBrowser.Document as IPersistStreamInit)260 .Load(TStreamAdapter.Create(ms));261 finally262 ms.Free;263 end;264 finally265 sl.Free;266 end;267 end;268 end;269 270 procedure TF_map.tmr1Timer(Sender: TObject);271 begin272 GetWebContent;273 end;274 275 procedure TF_map.FormCreate(Sender: TObject);276 begin277 loadweb;278 //Application.OnMessage:=AppMsg;279 end;280 281 procedure TF_map.FormShow(Sender: TObject);282 begin283 lng := '';284 lat := '';285 tmr1.Enabled := True;286 end;287 288 procedure TF_map.GetWebContent();289 var290 html: IHTMLDocument2; // 定义网页元素291 submitbutton: OleVariant; // 定义按钮292 centerweidu, centerjingdu, weidu, jingdu, weidutemp,293 jingdutemp: IHTMLElement; // 定义网页输入元素294 begin295 try296 html := self.WebBrowser.Document as IHTMLDocument2;297 centerweidu := html.all.item('centerweidu', 0) as IHTMLElement;298 centerjingdu := html.all.item('centerjingdu', 0) as IHTMLElement;299 weidu := html.all.item('weidu', 0) as IHTMLElement;300 jingdu := html.all.item('jingdu', 0) as IHTMLElement;301 weidutemp := html.all.item('weidutemp', 0) as IHTMLElement;302 jingdutemp := html.all.item('jingdutemp', 0) as IHTMLElement;303 edt1.Text := centerweidu.innerText;304 edt2.Text := centerjingdu.innerText;305 edt3.Text := weidutemp.innerText;306 edt4.Text := jingdutemp.innerText;307 Edit1.Text := weidu.innerText;308 Edit2.Text := jingdu.innerText;309 except310 end;311 end;312 313 end.