• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    迪恩网络公众号

在Delphi下基于MapWinGIS添加和删除图层标注的方法

原作者: [db:作者] 来自: [db:来源] 收藏 邀请
unit Form_MainU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,MapWinGIS_TLB, DB, Grids, DBGrids, DBTables, OleCtrls, ComCtrls,
  StdCtrls ;

type
  TForm1 = class(TForm)
    Button1: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Map1: TMap;
    Table1: TTable;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    StatusBar1: TStatusBar;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Map1MouseMove(ASender: TObject; Button, Shift: Smallint; x,
      y: Integer);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    AShape:Shapefile;
    MapHanle:integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  self.OpenDialog1.FileName :='*.SHP';
   if self.OpenDialog1.Execute() then
   begin
     AShape:=MapWinGIS_TLB.CoShapefile.Create;
     AShape.Open(self.OpenDialog1.FileName,nil);
     MapHanle:=self.Map1.AddLayer(AShape,true);
     self.Table1.TableName :=ExtractFilePath(self.OpenDialog1.FileName)+'grid.dbf';
     self.Table1.Active:=true;
   end;
end;

procedure TForm1.Map1MouseMove(ASender: TObject; Button, Shift: Smallint;
  x, y: Integer);
var
  XX,YY:Double;
begin
  Self.Map1.PixelToProj(x,y,XX,YY);
  Self.StatusBar1.Panels[0].Text :='X='+formatFloat('#.##',XX);
  Self.StatusBar1.Panels[1].Text :='Y='+formatFloat('#.##',YY);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i:Integer;
  x,y:Double;
begin
  for i:=0 to AShape.NumShapes-1 do
  begin
    x:=AShape.Shape[i].Extents.xMin;
    y:=AShape.Shape[i].Extents.yMin;
    Self.Map1.AddLabel(MapHanle,'v',clBlack,x,y,MapWinGIS_TLB.hjCenter);//添加标注
    Self.Map1.Redraw;//图层刷新
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  self.Map1.ClearLabels(MapHanle);//删除标注
  Self.Map1.Redraw;//刷新
end;

end.

 

MapWinGIS添加标注的速度还是很快的,9万多个标注添加到图层上,等待的时间还是可以忍受的,大概6~9秒钟吧。


鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
Delphi7以来的语法等变化发布时间:2022-07-18
下一篇:
MATLAB入门笔记发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap