unit1.pas

这个网站太鸡巴恶心了

{
 author: MyGIS软件工作室(http://www.mygis.com.cn)，培训用例
 date:2006
 function : 第3部分

 }

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, MapXLib_TLB, StdCtrls;

type
  TForm1 = class(TForm)
    Map: TMap;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    btnExit: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MapToolUsed(Sender: TObject; ToolNum: Smallint; X1, Y1, X2,
      Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool);
    procedure MapPolyToolUsed(Sender: TObject; ToolNum: Smallint;
      Flags: Integer; const Points: IDispatch; bShift, bCtrl: WordBool;
      var EnableDefault: WordBool);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
        map.CurrentTool := 100;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
        map.CurrentTool := 101;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
        map.CurrentTool := 102;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
// to finish it by yourself
        showmessage('无操作！-面积测量工具');
end;

procedure TForm1.btnExitClick(Sender: TObject);
begin
        application.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
        map.GeoSet := 'data/asia/asia.gst';

        Map.CreateCustomTool(100,miToolTypePoint,miArrowCursor,EmptyParam,EmptyParam,'点位置坐标');
        Map.CreateCustomTool(101,miToolTypeLine,miCrossCursor,EmptyParam,EmptyParam,'直线距离');
        Map.CreateCustomTool(102,miToolTypePoly,miCrossCursor,EmptyParam,EmptyParam,'折线距离');
end;

procedure TForm1.MapToolUsed(Sender: TObject; ToolNum: Smallint; X1, Y1,
  X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
  var EnableDefault: WordBool);
var
        sResult :string;
        ScreenX, ScreenY :OleVariant;
        MapX,MapY: OleVariant;
        dist :double;
begin
        if ToolNum = 100 then
        begin
                MapX := X1;
                MapY := Y1;
                Map.ConvertCoordV(ScreenX,ScreenY,MapX,MapY,miMapToScreen);
                sResult := '';
                sResult := sResult + '地理坐标：MapX=' + floattostr(X1)+ ';MapY=' + floattostr(Y1);
                sResult := sResult +  chr(10) + chr(13);
                sResult := sResult + '屏幕坐标：ScreenX=' + inttostr(ScreenX)+ ';ScreenY=' + inttostr(ScreenY);
                showmessage(sResult);
        end
        else if ToolNum = 101 then
        begin
                sResult := '距离：';
                //dist := map.Distance(x1,y1,x2,y2);
                dist := map.OleObject.distance(x1,y1,x2,y2);
                sResult := sResult + floattostr(dist);
                //sResult := sResult + floattostr(Distance);
                showmessage(sResult);
        end ;
end;

procedure TForm1.MapPolyToolUsed(Sender: TObject; ToolNum: Smallint;
  Flags: Integer; const Points: IDispatch; bShift, bCtrl: WordBool;
  var EnableDefault: WordBool);
var
        ftr : CMapXFeature;
        sResult :string;
begin
        if ToolNum = 102 then
        begin
                if Flags = miPolyToolEnd then
                begin
                        ftr := Map.FeatureFactory.CreateLine(Points,Map.DefaultStyle);
                        sResult := '距离：';
                        sResult := sResult + floattostr(ftr.Length);
                        showmessage(sResult);
                end;
        end;

end;

end.