⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 formmain.~pas

📁 delphi+mapx应用实例,包含MAPX所有功能!值得下载学习!
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
  xe,ye : double;
  select,ftrsselect,ftrselect,rc : variant;
  fid : string;
begin
  case toolnum of
    //自定义位图工具
    POINT_DRAW_TOOL:
    begin
      lyr := map1.Layers.Item[1];
      pnt :=copoint.Create;
      newstyle :=costyle.create;
      feafrc := map1.FeatureFactory ;
      newstyle.SymbolType:= misymboltypebitmap;
      newstyle.SymbolBitmapSize :=24;
      newstyle.SymbolBitmapTransparent :=false;
      newstyle.SymbolBitmapName :='towe1-32.bmp';
      //map1.AutoRedraw :=false;
      pnt.Set_(x1,y1);
      ftr :=feafrc.CreateSymbol(pnt,newstyle);
      map1.Layers.Item[1].AddFeature(ftr,emptyparam);
      //map1.Layers.Item(1).refresh;
    end;
    //自定义圆
    CRICLE_DRAW_TOOL :
    begin
      lyr := map1.Layers.Item[1];
      pnt := copoint.Create;
      newstyle := costyle.Create;
      newstyle.LineStyle := 29;
      newstyle.LineColor := 287;
      newstyle.LineWidth := 5;
      //ftr := cofeature.Create;
      //ftr.Attach(map1);
      lyr.Editable := true;
      pnt.Set_(x1,Y1);
      feafrc := map1.FeatureFactory;
      ftr := feafrc.CreateCircularRegion(miCircleTypeMap,pnt,distance,miUnitMile,32763,newstyle);
      lyr.AddFeature(ftr,emptyparam);
      //ftr.Update(emptyparam,emptyparam);
      //lyr.Editable := false;
    end;
    //自定义矩形工具
    RECT_DRAW_TOOL :
    begin
      pnt := copoint.Create;
      newstyle := costyle.Create;
      newstyle.LineStyle := miPenSolid;
      newstyle.LineColor := rgb(0,254,1);
      newstyle.LineWidthUnit := miStyleUnitPixel;
      newstyle.LineWidth := 5;
      pnts := copoints.Create;
      pnt.Set_(x1,y1);
      pnts.Add(pnt,1);
      pnt.Set_(x2,y1);
      pnts.Add(pnt,2);
      pnt.Set_(x2,y2);
      pnts.Add(pnt,3);
      pnt.Set_(x1,y2);
      pnts.Add(pnt,4);
      pnt.Set_(x1,y1);
      pnts.Add(pnt,5);

      //创建矩形
      feafrc := map1.FeatureFactory;
      ftr := feafrc.CreateLine(pnts,newstyle);
      map1.Layers.Item[1].addfeature(ftr,emptyparam);
    end;

    //移动图元
    MOVE_FEATURE_TOOL :
    begin
      pnt := copoint.Create;
      pnt.Set_(x1,y1);
      xe := x2-x1;
      ye := y2-y1;
      lyr := map1.Layers.Item['usa'];
      lyr.Editable := true;
      ftrs := lyr.SearchAtPoint(pnt,emptyparam);
      select := lyr.Selection;
      //select.clear;
      select.add(ftrs);
      ftrsselect := select.clone;
      for j := 1 to ftrsselect.count do
      begin
        ftrselect := ftrsselect.item(j);
        ftrselect.offset(xe,ye);
        //lyr.UpdateFeature(emptyparam,emptyparam,emptyparam);
        map1.Layers.Item[1].addfeature(ftrselect,emptyparam);
      end;
      lyr.Editable := false;
    end;
    //图数互查
    INFO_POINT_TOOL :
    begin
      lyr := map1.Layers.Item['US Capitals'];
      dst := map1.Datasets.add(midatasetlayer,lyr,emptyparam,emptyparam,emptyparam,emptyparam,emptyparam,emptyparam);
      flds := dst.fields;
      pnt := copoint.Create;
      pnt.Set_(x1,y1);
      ftrs := lyr.SearchAtPoint(pnt,emptyparam);
      for i := 1 to ftrs.Count do
      begin
        ftr := ftrs.item[i];
        infoform.Listfields.Clear;
        infoform.Listvalues.Clear;
        for j := 1 to flds.Count do
        begin
          fldsname1[j] := flds.item[j].name;
          lyr.KeyField := fldsname1[j];
          //showmessage(fldsname1[j]);
          //showmessage(ftr.KeyValue);
          //application.MessageBox(pchar(fldsname1[j]),'',0);
          infoform.listfields.Items.Add(fldsname1[j]);
          infoform.Listvalues.Items.add(ftr.KeyValue);
        end;
      end;
      infoform.Show;
    end;

    //得到选取框内的FEATURES的ID
    SEARCH_RECTANGLE_TOOL :
    begin
      rc := CreateOleObject('MapX.Rectangle.4');
      rc.Set(X1, Y1, X2, Y2);
      for i := 1 to map1.Layers.Count do
      begin
        lyr := map1.Layers.Item[i];
        ftrs := lyr.SearchWithinRectangle(rc,MiSelectionNew);
        for j := 1 to ftrs.Count do
        begin
          ftr := ftrs.Item[j];
          str(ftr.FeatureID,fid);
          getidform.searchID.items.Add(ftr.Name + ' id: ' + fID);
          getidform.Show;
        end;
      end;
    end;

  end;//end case

end;

procedure Tmainform.N22Click(Sender: TObject);
begin
  map1.CurrentTool := CRICLE_DRAW_TOOL;
end;

procedure Tmainform.N23Click(Sender: TObject);
begin
  map1.CurrentTool := RECT_DRAW_TOOL;
end;

procedure Tmainform.N27Click(Sender: TObject);
begin
  Map1.DefaultStyle.PickSymbol;
end;

procedure Tmainform.N28Click(Sender: TObject);
begin
  Map1.DefaultStyle.PickLine;
end;

procedure Tmainform.N29Click(Sender: TObject);
begin
  Map1.DefaultStyle.PickRegion;
end;

procedure Tmainform.N30Click(Sender: TObject);
begin
  map1.CurrentTool := miradiusselecttool;
end;

procedure Tmainform.N31Click(Sender: TObject);
begin
  map1.CurrentTool := mirectselecttool;
end;

procedure Tmainform.N32Click(Sender: TObject);
begin
  map1.CurrentTool := miselecttool;
end;

procedure Tmainform.layerinfo1Click(Sender: TObject);
begin
  layerform.show;
end;

procedure Tmainform.N35Click(Sender: TObject);
begin
  searchform.show;
end;

procedure Tmainform.N36Click(Sender: TObject);
begin
  map1.CurrentTool := INFO_POINT_TOOL;
end;

procedure Tmainform.N38Click(Sender: TObject);
begin
  themeform.show;
end;

procedure Tmainform.N39Click(Sender: TObject);
var
  i : integer;
begin
  for i :=1 to map1.Datasets.Count do
  begin
    map1.Datasets.Item[i].Themes.RemoveAll;
  end;
end;

procedure Tmainform.N40Click(Sender: TObject);
begin
  map1.CurrentTool := miarrowtool;
end;

procedure Tmainform.ODBC1Click(Sender: TObject);
var
  dst:mapxlib_tlb.dataset;
  flds: mapxlib_tlb.fields;
  parm: variant;
begin
  parm := CreateOleObject('MapX.ODBCQueryInfo.4');
  parm.sqlquery:='select * from USA';
  parm.ConnectString := 'ODBC;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=D:\Program Files\mapinfo\ MapX 4.0\Data\MapStats.mdb;';
  parm.DataSource := '';
  flds := CoFields.Create;
  flds.Add('GEOABBR', 'GEOABBR', miAggregationAuto, miTypeString);
  flds.Add('GEONAME', 'GEONAME', miAggregationAuto, miTypeString);
  flds.Add('TOTPOP', 'TOTPOP', miAggregationAuto, miTypeNumeric);
  dst := Map1.Datasets.Add(miDataSetODBC, parm, 'ODBC Dataset',EmptyParam, EmptyParam, 'USA', flds, EmptyParam);
  dst.Themes.Add(EmptyParam, EmptyParam, EmptyParam, EmptyParam);
  dst.Themes.Item[1].themedlg(emptyparam,emptyparam);
end;

procedure Tmainform.N33Click(Sender: TObject);
var
  path : string;
begin
  savedialog1.Filter := 'mapinfo files(*.gst)|*.gst';
  if savedialog1.Execute then
    if savedialog1.FileName<>'*.gst' then
      begin
        path := savedialog1.FileName;
        map1.SaveMapAsGeoset('',path);
      end;
end;

procedure Tmainform.N41Click(Sender: TObject);
var
  lyr : cmapxlayer;
  dst : cmapxdataset;
begin
  lyr := map1.Layers.Item['usa'];
  dst := map1.Datasets.Add(midatasetlayer,lyr,emptyparam,emptyparam,emptyparam,emptyparam,emptyparam,emptyparam);
  lyr.LabelProperties.Dataset := dst;
  lyr.LabelProperties.DataField := dst.Fields.Item['state_name'];
  lyr.LabelProperties.Position := miPositionBR;
  lyr.LabelProperties.Offset := 2;
  //lyr.LabelProperties.PartialSegments := false;
  //lyr.LabelProperties.Visible := false;
  //lyr.LabelProperties.Style := 90;
  lyr.AutoLabel := true;
end;

procedure Tmainform.IF1Click(Sender: TObject);
begin
  savedialog1.Filter := 'tif files(*.tif)|*.tif';
  if savedialog1.Execute then
    if savedialog1.FileName<>'*.tif' then
    begin
      map1.ExportMap(savedialog1.FileName,miformattif,12);
    end;
end;

procedure Tmainform.N43Click(Sender: TObject);
begin
  map1.PaperUnit := miunitcentimeter;
  map1.ExportMap('clipboard',miformatbmp,12,9);
end;

procedure Tmainform.EXCEL1Click(Sender: TObject);
//type
  //excel1 = array[0..100] of CreateOleObject('MapX.ODBCQueryInfo.4');//variant;
var
  lyr : cmapxlayer;
  I,j : integer;
  flds : cmapxfields;
  dst : cmapxdataset;
  ftr : cmapxfeature;
  ftrs : cmapxfeatures;
  excel : variant;//excel1;
begin
  excel := CreateOleObject('MapX.ODBCQueryInfo.4');
  lyr := map1.Layers.Item['US Capitals'];
  dst := map1.Datasets.add(midatasetlayer,lyr,emptyparam,emptyparam,emptyparam,emptyparam,emptyparam,emptyparam);
  flds := dst.fields;
  ftrs := lyr.AllFeatures;
  for i := 1 to flds.Count do
  begin
    lyr.KeyField :=flds.item[i].Name;
    for j := 1 to ftrs.Count do
    begin
      ftr := ftrs.Item[j];
      excel[j,i].cell := ftr.keyvalue;
    end;
  end;



end;

procedure Tmainform.N44Click(Sender: TObject);
begin
  map1.CurrentTool := MOVE_FEATURE_TOOL;
end;

procedure Tmainform.ID1Click(Sender: TObject);
begin
  map1.CurrentTool := SEARCH_RECTANGLE_TOOL;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -