tdistancetoolclass.pas

Purpose: 量距离工具 History: 2005-05-21 开发环境： delphi7+mapX 5.02.38 windows XP Sp2

{-----------------------------------------------------------------------------
 Unit Name: TDistanceToolClass
 Author:    杜长宇  [e-mail]
 Purpose: 量距离工具
 History:  2005-05-21

 开发环境： delphi7+mapX 5.02.38
            windows XP Sp2

 许可：
    您可以自由的使用本代码进行学习或非商业、商业应用，
    你可以自由更改本代码以便更适合你的应用，但请保留原作者版权信息；
    如果你对本代码作过修改优化，请添加详细注释后重新发布到网上，并发给原作者一份拷贝，以利于大家共同进步；


 用法：
   1、主程序中uses ToolButtonDistance；
   2、在主程序窗体中放置ToolButtonDistance
   3、添加事件处理函数，形如：
procedure TForm1.ToolButtonDistanceClick(Sender: TObject);
var
  m_MapDistanceTool : TDistanceTool;
begin
  m_MapDistanceTool := TDistanceTool.Create;
  m_MapDistanceTool.CreateDistanceTool(map1);
  Map1.CurrentTool := m_MapDistanceTool.GetToolNum;
end;

-----------------------------------------------------------------------------}


unit TDistanceToolClass;

interface
uses Controls,Classes,MapXLib_TLB,Variants,TeEngine,windows,SysUtils,
   DistanceWindow,Math;

type
  TDistanceTool = class(TObject)
  protected
    m_IriMouseMoveEvent:TMouseMoveEvent;
    m_IriMouseClickInMapEvent:TNotifyEvent;
    m_IriMouseDoubleClickInMapEvent:TNotifyEvent;
    m_pMap:Tmap;

    m_bToolInUse:Boolean;
    m_sPreviousMapX:Single;
    m_sPreviousMapY:Single;
    m_sCurrentMapX:Single;
    m_sCurrentMapY:Single;

    m_dTotalDistance:double;

    m_lTotalDistancePoint:integer;
    m_bTotalDistanceShow:boolean;
    m_lRulePolyLineFeatuerID : integer;
    m_lRuleLineFeatuerID : integer;

    m_strRuleFlagLayer : string;

    m_frmDistanceWindow : TfrmDistanceWindow;
    
  protected
    procedure MapMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure MapMouseClick(Sender: TObject);
    procedure MapMouseDoubleClick(Sender: TObject);
  private
  { Private declarations }
    procedure ShowTheResult(dDistance,dTotalDistance:double;sDistanceUnit:string);
  public
  { public declarations }
    Function CreateDistanceTool(var pMap:TMap):Integer;
    Function InstallDistanceTool():Boolean;
    Function UnInstallDistanceTool():Boolean;
    Function GetToolNum():Integer;

end;

const
  MAP_DISTANCE_TOOL = 1;
  
implementation

uses dchyMapModule;

var
  myMapModule : TdchyMapModule;


function TDistanceTool.CreateDistanceTool(var pMap: TMap): Integer;
begin
    m_pMap:=pMap;
    if m_pMap<>nil then
    begin
      m_pMap.CreateCustomTool(MAP_DISTANCE_TOOL,miToolTypePoint, miCrossCursor, miCrossCursor, miCrossCursor);
      //初始化
      m_strRuleFlagLayer :='RulerTempLayer';
      m_dTotalDistance:=0.0;
      m_lTotalDistancePoint:=0;

      InstallDistanceTool;
      result:=MAP_DISTANCE_TOOL;
    end 
    else 
      result:=-1;
end;

function TDistanceTool.GetToolNum: Integer;
begin
  result:=MAP_DISTANCE_TOOL;
end;

function TDistanceTool.InstallDistanceTool: Boolean;
begin
  if m_pMap<>nil then
  begin
    //保存原先的事件处理函数状态
    m_IriMouseMoveEvent:=m_pMap.OnMouseMove;
    m_IriMouseClickInMapEvent:=m_pMap.OnClick;
    m_IriMouseDoubleClickInMapEvent:=m_pMap.OnDblClick;
    
    m_pMap.OnMouseMove:=MapMouseMove;
    m_pMap.OnClick:=MapMouseClick;
    m_pMap.OnDblClick:=MapMouseDoubleClick;

    result:=True;
  end
  else
    result:=False;
end;

procedure TDistanceTool.MapMouseClick(Sender: TObject);
var
  dDistance : double;
  newobj : CMapXFeature; // Standalone object
  obj : CMapXFeature;    // to hold object added to layer
  style : CMapXStyle;
  PolyLinePoints : CMapXPoints;

  LinePoints : CMapXPoints;
  currentPoint : CMapXPoint;

  index : integer;
  pointsCount : integer;
  layer :CMapXLayer;

begin
  if m_pMap.CurrentTool = MAP_DISTANCE_TOOL then begin

    if m_lTotalDistancePoint <> 0 then begin
      dDistance := m_pMap.Distance(m_sPreviousMapX,m_sPreviousMapY,m_sCurrentMapX,m_sCurrentMapY);
      m_dTotalDistance := m_dTotalDistance + dDistance;
    end;

    m_sPreviousMapX:=m_sCurrentMapX;
    m_sPreviousMapY:=m_sCurrentMapY;
    m_lTotalDistancePoint:=m_lTotalDistancePoint+1;
    m_bTotalDistanceShow:=TRUE;

    //创建临时图层
    if myMapModule.GetLayerIndex(m_pMap,m_strRuleFlagLayer)<0 then
      myMapModule.CreateTempAnimationLayer(m_pMap,m_strRuleFlagLayer);

    m_pMap.Layers.Item[m_strRuleFlagLayer].Editable := true;

    if m_lRulePolyLineFeatuerID = 0 then begin
      try
        PolyLinePoints := CoPoints.Create;
        PolyLinePoints.AddXY(m_sCurrentMapX,m_sCurrentMapY,EmptyParam);
        PolyLinePoints.AddXY(m_sCurrentMapX,m_sCurrentMapY,EmptyParam);

        newobj := CoFeature.Create;
        newobj.Attach(m_pMap.ControlInterface);
        newobj.type_ := miFeatureTypeLine;
        newobj.Parts.Add(PolyLinePoints);
        obj := m_pMap.Layers.Item[m_strRuleFlagLayer].AddFeature(newobj,EmptyParam);

        style := m_pMap.Layers.Item[m_strRuleFlagLayer].Style.Clone;
        style.LineColor := miColorRed;
        style.LineStyle := miLineTypeSimple;
        style.LineWidth := 4;
        obj.Style := style;
        obj.Update(EmptyParam,EmptyParam);

        m_lRulePolyLineFeatuerID :=obj.FeatureID;
      except
        raise;
      end;
    end
    else
      try
        obj := m_pMap.Layers.Item[m_strRuleFlagLayer].GetFeatureByID(m_lRulePolyLineFeatuerID);
        style := m_pMap.Layers.Item[m_strRuleFlagLayer].Style.Clone;
        style.LineColor := miColorRed;
        style.LineStyle := miLineTypeSimple;
        style.LineWidth := 4;
        obj.Style := style;

        PolyLinePoints := obj.Parts.Item[1];
        PolyLinePoints.AddXY(m_sCurrentMapX,m_sCurrentMapY,EmptyParam);
        obj.Parts.Add(PolyLinePoints);
        obj.Parts.Remove(2);
        obj.Update(EmptyParam,EmptyParam);
      except
        raise;
      end;

      if m_lRuleLineFeatuerID=0 then begin
        try
          LinePoints := CoPoints.Create;
          LinePoints.AddXY(m_sCurrentMapX,m_sCurrentMapY,EmptyParam);
          LinePoints.AddXY(m_sCurrentMapX,m_sCurrentMapY,EmptyParam);

          newobj := m_pMap.FeatureFactory.CreateLine(LinePoints,EmptyParam);
          obj := m_pMap.Layers.Item[m_strRuleFlagLayer].AddFeature(newobj,EmptyParam);
          style := m_pMap.Layers.Item[m_strRuleFlagLayer].Style.Clone;
          style.LineColor := miColorRed;
          style.LineStyle := miLineTypeSimple;
          style.LineWidth := 4;
          obj.Style := style;
          obj.Update(EmptyParam,EmptyParam);

          m_lRuleLineFeatuerID := obj.FeatureID;
        except
          raise;
        end;
      end
      else begin
        obj:=m_pMap.Layers.Item[m_strRuleFlagLayer].GetFeatureByID(m_lRuleLineFeatuerID);
        obj.Parts.Item[1].Item[1].Set_(m_sCurrentMapX,m_sCurrentMapY);
        obj.Parts.Item[1].Item[2].Set_(m_sCurrentMapX,m_sCurrentMapY);
        obj.Update(EmptyParam,EmptyParam);
      end;
  end;
  //just for debuging;
  //m_pMap.Layers.LayersDlg(EmptyParam,EmptyParam);
  if @m_IriMouseClickInMapEvent<>nil then
    m_IriMouseClickInMapEvent(Sender);

end;

procedure TDistanceTool.MapMouseDoubleClick(Sender: TObject);
var
  layer : CMapXLayer;
  features : CMapXFeatures;
  obj : CMapXFeature;
  i : integer;

begin
  if m_pMap.CurrentTool = MAP_DISTANCE_TOOL then begin
    m_lTotalDistancePoint:=0;
    m_dTotalDistance:=0.0;
    m_bTotalDistanceShow:=FALSE;
    m_lRulePolyLineFeatuerID:=0;
    m_lRuleLineFeatuerID:=0;

    if myMapModule.GetLayerIndex(m_pMap,m_strRuleFlagLayer)<>-1 then begin
      layer := m_pMap.Layers.Item[m_strRuleFlagLayer];
      features := layer.AllFeatures;
      for i:=0 to features.Count-1 do begin
        obj:=features.Item[i+1];
        layer.DeleteFeature(obj);
      end;
    end;

  m_pMap.CurrentTool :=  miArrowTool;
  myMapModule.DeleteTempAnimationLayer(m_pMap,m_strRuleFlagLayer);
  UnInstallDistanceTool;
  end;

  if @m_IriMouseDoubleClickInMapEvent<>nil then
    m_IriMouseDoubleClickInMapEvent(Sender);

end;

procedure TDistanceTool.MapMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  dDist,dRectLen,dRectWidth : double;
  screenX,screenY : Single;
  mapX,mapY : double;
  obj : CMapXFeature;
var
  myMapModule : TdchyMapModule;
  mapUnit : string;
begin
  if m_pMap.CurrentTool = MAP_DISTANCE_TOOL then begin
    screenX:=X;
    screenY:=Y;
    m_pMap.ConvertCoord(screenX,screenY,mapX,mapY,miScreenToMap);

    m_sCurrentMapX:=mapX;
    m_sCurrentMapY:=mapY;

    if m_bTotalDistanceShow then begin
       dDist:=m_pMap.Distance(m_sPreviousMapX,m_sPreviousMapY,mapX,mapY);
       mapUnit := myMapModule.GetChineseMapUnit(m_pMap,m_pMap.MapUnit);
       ShowTheResult(dDist,m_dTotalDistance+dDist,mapUnit);
       myMapModule.AutoPan(m_pMap,mapX,mapY,24.0,18.0);

       if(m_lRuleLineFeatuerID<>0)then begin
          obj:=m_pMap.Layers.Item[m_strRuleFlagLayer].GetFeatureByID(m_lRuleLineFeatuerID);
          obj.Parts.Item[1].Item[2].Set_(m_sCurrentMapX,m_sCurrentMapY);
          obj.Update(EmptyParam,EmptyParam);
       end;
    end;
  end;

  if @m_IriMouseMoveEvent<>nil then
    m_IriMouseMoveEvent(Sender,Shift,X,Y);
end;

procedure TDistanceTool.ShowTheResult(dDistance, dTotalDistance: double;sDistanceUnit:string);
begin
    //激活距离显示窗口
    if m_frmDistanceWindow<>nil then begin
      dDistance := RoundTo(dDistance,-2);  //四舍五入，保留两位
      dTotalDistance := RoundTo(dTotalDistance,-2);

      m_frmDistanceWindow.lblDistance.Caption := floatToStr(dDistance)+sDistanceUnit;
      m_frmDistanceWindow.lblTotalDistance.Caption := floatToStr(dTotalDistance)+sDistanceUnit;
      m_frmDistanceWindow.Show;
    end
    else begin
      m_frmDistanceWindow:=TfrmDistanceWindow.Create(nil);
      m_frmDistanceWindow.Show;
    end;
end;

function TDistanceTool.UnInstallDistanceTool: Boolean;
begin
    if m_pMap<>nil then
    begin
      //回复原先的事件处理函数状态
      m_pMap.OnMouseMove:=m_IriMouseMoveEvent;
      m_pMap.OnClick := m_IriMouseClickInMapEvent;
      m_pMap.OnDblClick := m_IriMouseDoubleClickInMapEvent;
      m_IriMouseMoveEvent:=nil;
      m_IriMouseClickInMapEvent:=nil;
      m_IriMouseDoubleClickInMapEvent:=nil;
      m_pMap:=nil; 
      result:=True; 
    end 
    else 
      result:=False;
end;

end.