Delphi专题 ·

Delphi调用百度地图(Delphi+百度Api+Access)示例

前几天,一个学生朋友写论文,要用Delphi调用百度地图,匆匆忙忙写了一个Delphi与html、Access的交互,大概实现了他想要的功能。加入了将Html保存为图片、百度地图普通视图与混合视图的切换、有些函数是直接从网上摘取的,这里向原作者表示感谢,不多说上代码:

Delphi调用百度地图(Delphi+百度Api+Access)示例 Delphi专题 第1张

function ExecuteJavaScript(WebBrowser: TWebBrowser; Code: string): Variant;
// 获取js函数
var
  Document: IHTMLDocument2;
  Window: IHTMLWindow2;
begin
  // execute javascript in webbrowser
  Document := WebBrowser.Document as IHTMLDocument2;
  if not Assigned(Document) then
    Exit;
  Window := Document.parentWindow;
  if not Assigned(Window) then
    Exit;
  try
    Result := Window.execScript(Code, 'JavaScript');
  except
    on E: Exception do
      raise Exception.Create('Javascript error ' + E.Message +
        ' in: '#13#10 + Code);
  end;
end;

procedure TMainForm.N5Click(Sender: TObject); // 保存Html图片
var
  ViewObject: IViewObject;
  sourceDrawRect: TRect;
begin
  if SavePictureDialog1.Execute then
  begin
    if Webbrowser1.Document <> nil then
      try
        Webbrowser1.Document.QueryInterface(IViewObject, ViewObject);
        if ViewObject <> nil then
          try
            sourceDrawRect := Rect(0, 0, Image1.Width, Image1.Height);
            ViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Self.Handle,
              Image1.Canvas.Handle, @sourceDrawRect, nil, nil, 0);
            Image1.Repaint;
          finally
            ViewObject._Release;
          end;
      except
      end;
    Image1.Picture.SaveToFile(SavePictureDialog1.FileName + '.jpeg');
  end;
end;

procedure TMainForm.N20Click(Sender: TObject); // 切换百度地图视图
begin
  N20.Checked := True;
  N21.Checked := False;
  try
    ExecuteJavaScript(Webbrowser1, 'Baidumaptype(' + 'BMAP_NORMAL_MAP' + ');');
    // 普通视图,BMAP_HYBRID_MAP为混合视图
  except
    on E: Exception do
      showmessage(E.Message);
  end;
end;

相关下载

点击下载

参与评论