mainform.pas

来自「GIS中用mapx侧距离」· PAS 代码 · 共 602 行 · 第 1/2 页

unit MainForm;

interface

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

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    ools1: TMenuItem;
    Pen1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    Panel1: TPanel;
    Splitter1: TSplitter;
    Panel2: TPanel;
    Panel3: TPanel;
    Splitter2: TSplitter;
    Panel4: TPanel;
    Map1: TMap;
    Panel5: TPanel;
    Splitter3: TSplitter;
    Panel6: TPanel;
    Map2: TMap;
    N9: TMenuItem;
    N10: TMenuItem;
    Button1: TButton;
    N11: TMenuItem;
    N12: TMenuItem;
    Label1: TLabel;
    N13: TMenuItem;
    N14: TMenuItem;
    N21: TMenuItem;
    N31: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    procedure Pen1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Map1AddNewLayer;
    procedure Map2AddNewLayer;
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure Map1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N12Click(Sender: TObject);
    procedure Map1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure N10Click(Sender: TObject);
    procedure Map1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Map1MapViewChanged(Sender: TObject);
    procedure Map2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Map2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Map2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N14Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure N31Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
    RULERTOOL            = 104;                 // 直线测量工具标识号
    POLYRULERTOOL        = 105;                 // 折线测量工具标识号
    MYTOOL_DISTANCE      = 107;

    AddPolygonRegionTool = 106;

var
  Form1 : TForm1;
  G_dblMouseDownMapX : Double;
  G_dblMouseDownMapY : Double;
  G_dblMouseDownMapX1 : Double;
  G_dblMouseDownMapY1 : Double;

  G_dblDistanceSoFar : Double;

//  //----------以下三个全局变量用于鹰眼视图
  G_MouseDownFlag : string;      //当鼠标按下时为True;
  G_MouseDownMapX : integer;      //按下时的X坐标
  G_MouseDownMapY : integer;      //按下时的Y坐标
//
//  //G_dblDistanceSoFar : Double;


implementation


{$R *.dfm}

procedure TForm1.Pen1Click(Sender: TObject);
begin
    Map1.CurrentTool := 1001    // miPenTool;
    //Map1.CurrentTool := miPenTool;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
    Map1.CurrentTool := 1003;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
     Map1.CurrentTool := 1004;
end;

procedure TForm1.N8Click(Sender: TObject);
begin
    Map1.CurrentTool := miSelectTool;
end;

procedure TForm1.N4Click(Sender: TObject);
var
    lyrInsertion : Layer;
begin
    //lyrInsertion := Map1.Layers('注记');
    //lyrInsertion := Map1.l
    lyrInsertion := Map1.Layers[1];
    lyrInsertion.Editable := True;
    Map1.Layers.InsertionLayer := lyrInsertion;

    //Map1.CurrentTool := 1012;
    Map1.CurrentTool := miAddLineTool;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
    MyFont : TFont;
begin
    Form1.Width := 1024;
    Form1.Height := 768;
    Form1.Top := 0;
    Form1.Left := 0;

    Map1.CreateCustomTool( RULERTOOL, miToolTypeLine, miCrossCursor );
    Map1.CreateCustomTool( POLYRULERTOOL, miToolTypePoly, miCrossCursor );
    Map1.CreateCustomTool( AddPolygonRegionTool, miToolTypePolygon, miCrosscursor );

    MyFont := TFont.Create;
    OleFontToFont(Map1.DefaultStyle.SymbolFont, MyFont);
    MyFont.Size := 24;
    MyFont.Name := 'MapInfo Transportation';
    Map1.DefaultStyle.SymbolCharacter := 66;
    Map1.DefaultStyle.SymbolFontColor := clRed;
    Map2.DefaultStyle.RegionPattern := 0;         // 不填充
    Map2.DefaultStyle.RegionBorderStyle := 3;     // 虚线


    Map1AddNewLayer;
    Map2AddNewLayer;
end;

procedure TForm1.Map1AddNewLayer;
var
    //path, fileName : String;
    empty: Variant;
    lyrMyLayer : Variant;
begin
     try
        TVarData(empty).vType := varError;
        TVarData(empty).vError := DISP_E_PARAMNOTFOUND;
//        path := pathEdit.Text;
//        fileName := nameEdit.Text;
//        if tempTableCheckBox.checked = True then
           // Map1.Layers.CreateLayer('tmp', empty, 1, empty, empty);
           lyrMyLayer := Map1.Layers.CreateLayer('Cars', empty, 1, empty, empty);    // 生成一个新的图层
           //lyrMyLayer.miUnitKilometer;
           lyrMyLayer.ZoomLayer := True;
           lyrMyLayer.ZoomMin := 0;
           lyrMyLayer.ZoomMax := 10;
           Map1.Layers.AnimationLayer := Map1.Layers.Item[lyrMyLayer.name];          // 定义为动态图层

//        else
//            MainMap.Map1.Layers.CreateLayer(fileName,path + '\' + fileName, 1, empty, empty);
     except on E:Exception Do showMessage('File Creation Failed.');

     end;  //Try
end;

procedure TForm1.N5Click(Sender: TObject);
var
    lyrInsertion : Layer;
begin
    lyrInsertion := Map1.Layers[1];
    lyrInsertion.Editable := True;
    Map1.Layers.InsertionLayer := lyrInsertion;

    Map1.CurrentTool := miAddPolylineTool;
end;

procedure TForm1.N6Click(Sender: TObject);
var
    lyrInsertion : Layer;
begin
    lyrInsertion := Map1.Layers[1];
    lyrInsertion.Editable := True;
    Map1.Layers.InsertionLayer := lyrInsertion;

    Map1.CurrentTool := miAddPointTool;
end;

procedure TForm1.Map1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
    TmpX : single;
    TmpY : single;
begin

    G_MouseDownFlag := 'Begin';

    if (Map1.CurrentTool = RULERTOOL ) or (Map1.CurrentTool = POLYRULERTOOL ) then
    begin
        TmpX := X;
        TmpY := Y;
        Map1.ConvertCoord( TmpX, TmpY, G_dblMouseDownMapX, G_dblMouseDownMapY, miScreenToMap );
    end;
end;

procedure TForm1.N12Click(Sender: TObject);
begin
    Map1.CurrentTool := RULERTOOL;
    G_dblMouseDownMapX := 0;
    G_dblMouseDownMapY := 0;
end;

procedure TForm1.Map1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
    TmpX : single;
    TmpY : Single;
    dblMapX : Double;
    dblMapY : Double;
    dblDistanceSoFar : Double;
    distanceStr: string;
begin
    if G_MouseDownFlag = 'Begin' then
    begin

    TmpX := X;
    TmpY := Y;
    dblMapy := 0;
    dblMapX := 0;

    if (Map1.CurrentTool = RULERTOOL ) or ( Map1.CurrentTool = POLYRULERTOOL )  then
    begin
        Map1.ConvertCoord( TmpX, TmpY, dblMapX, dblMapY, misCreenToMap);

        Map1.MapUnit := miUnitKilometer;

        dblDisTanceSoFar := G_DblDistanceSoFar + Map1.Distance(G_dblMouseDownMapX, G_dblMouseDownMapY, dblMapX, dblMapY);

        distanceStr := Format('两点距离:%*.*f公里', [0, 3, dblDistanceSoFar]);
        label1.Caption := distancestr;
    end;
    end;

end;

procedure TForm1.N10Click(Sender: TObject);
begin
Map1.CurrentTool := miCenterTool
end;

procedure TForm1.Map1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    if (Map1.CurrentTool = 1 ) or (Map1.CurrentTool = 2) then
    begin
    end;
    G_MouseDownFlag := 'End';
end;

procedure TForm1.Map1MapViewChanged(Sender: TObject);
var
    I: Integer;
    MapViewRect : CMapXRectangle;

    pnt1     : Variant;
    pnt2     : Variant;
    pnt3     : Variant;