代码名称：Delphi7.0+MapX4.50.78信息工具

作者/收集者：yunfan10

开发环境：Delphi7.0+MapX4.50.78

代码：

Const
    INFO_TOOL = 400;
===================================================
procedure TGisFrame.FormCreate(Sender: TObject);
begin
    Map1.CreateCustomTool(INFO_TOOL,miToolTypePoint,miCustomCursor);
end;
====================================================
procedure TGisFrame.Map1ToolUsed(ASender: TObject; ToolNum: Smallint; X1,
  Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
  var EnableDefault: WordBool);
var
    i,j : ShortInt;
    lyr : CMapXLayer;
    pt  : CMapXPoint;
    ftrs: CMapXFeatures;
    strInfo : string;
    ds  : CMapXDataset;
begin
    case ToolNum of
   //创建信息工具  ==================================================
    INFO_TOOL:
    begin
        InfoUnt.InfoFrm.Show;
        InfoUnt.InfoFrm.ListBox1.Clear;
        //InfoFrm.Form1.:=True;
        pt := CoPoint.Create ;
        Pt.Set_(x1,y1);
        for j := 1 to Map1.Layers.Count do
        begin
            lyr := Map1.Layers.Item( j ) ;
            if lyr.Selectable then
            begin
                ftrs := lyr.SearchAtPoint( pt ) ;

                if ftrs.Count >0 then
                begin
                    StrInfo := '所在图层:' + lyr.Name ;
                    InfoUnt.InfoFrm.ListBox1.Items.Add(strInfo);

                    ds := Map1.Datasets.Add(miDataSetLayer,lyr,EmptyParam,
                       EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam);

                    InfoUnt.InfoFrm.ListBox1.Items.Add('ID:'+inttostr(ftrs.Item(1).FeatureID));

                    lyr.Selection.SelectByID(ftrs.Item(1).FeatureID,0);
                    //ftrs.Item(1).Style.RegionColor:=miColorRed;
                    for i := 1 to ds.Fields.Count do
                    begin
                        lyr.KeyField := ds.Fields.Item( i ).Name ;
                        StrInfo :=  ds.Fields.Item( i ).Name +':';

                        StrInfo := StrInfo + ftrs.Item( 1 ).Keyvalue ;
                        InfoUnt.InfoFrm.ListBox1.Items.Add(StrInfo);
                    end ;
                   Break; //找到就退出
                end;
            end;
         end;//for end;
         //if ftrs.Count = 0 then ShowMessage( '没有图元被选中!' ) ;
    end;
end;
====================================================
procedure TGisFrame.N18Click(Sender: TObject);
var
    exePath : string;
begin
//    exePath := ExtractFilePath(Application.ExeName)+'cursor\info.cur';
//    Map1.MouseIcon:=exePath;
    Map1.MousePointer := 0;
    Map1.CurrentTool := INFO_TOOL;
end;