mapxtools.~pas

此代码是关于mapgis的在

unit MapXTools;

interface

uses
  Classes, Windows, SysUtils, StdCtrls, MapXLib_TLB, Variants, Graphics,
  Dialogs, Controls, Forms, MapXBase, MapXContainer, Math, MapXConsts;

type
  TTrackLineType=(tlCustom, tlHorz, tlVert);
  {系统工具类，不允许继承}
  TMapXBaseTool=class(TBaseMapTool)
  private
    FMapX:TMapXObject;
  protected
    function GetMapX:TMapXObject; override;
    procedure SetMapX(Value:TMapXObject); override;
  public
    constructor Create(aCollection:TToolList); override;
    class function IsUserMapTool:Boolean; override;
    function IsComplete:Boolean; override;
  end;
  
  {用户工具的基类}
  TCustomMapTool=class(TBaseMapTool)
  private
    FMapManager: TMapManager;
    procedure CheckMapXObject;
  protected
    FAutoToolId:Boolean;
    procedure InitTool;virtual;
    procedure RegisterMethodProc; virtual;
    function GetMapX:TMapXObject; override;
    procedure SetMapX(Value:TMapXObject); override;
  public
    constructor Create(aCollection:TToolList); override;
    class function IsUserMapTool:Boolean; override;
    {绑定到MapX上}
    procedure BindTool;
    property MapManager:TMapManager read FMapManager write FMapManager;
    property AutoToolId:Boolean read FAutoToolId;
  end;

  {测距尺工具，用户子定义工具}
  TRulerMapTool=class(TCustomMapTool)
  private
    m_X1:Double;
    m_Y1:Double;
    FDistance: Double;
    procedure RulerToolUsed;
  protected
    procedure InitTool;override;
    procedure RegisterMethodProc; override;
  public
    function IsComplete:Boolean; override;
  published
    procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure DoToolUsed(ASender: TObject; ToolNum: Smallint; X1,
      Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool);
    property Distance:Double read FDistance;
  end;

  TClipMapTool=class(TCustomMapTool)
  private
  protected
    procedure InitTool;override;
    procedure RegisterMethodProc; override;
  public
    function IsComplete:Boolean; override;
  published
    procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure DoToolUsed(ASender: TObject; ToolNum: Smallint; X1,
      Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool);
  end;

  TLayerMapTool=class(TCustomMapTool)
  private
    FLayerManager: TLayerManager;
    FTrackLayer: CMapXLayer;
  published
    property LayerManager:TLayerManager read FLayerManager write FLayerManager;
    property TrackLayer:CMapXLayer read FTrackLayer write FTrackLayer;
  end;

  TAddObjectMapTool=class(TLayerMapTool)
  private
    FSymbolIndex: Integer;
    FDefaultValue: string;
    FEditFeature: Feature;
    FAutoShowPropDialog: Boolean;
  public
    constructor Create(aCollection:TToolList); override;
    procedure ShowPropDialog;
    property EditFeature:Feature read FEditFeature write FEditFeature;
  published
    property DefaultValue:string read FDefaultValue write FDefaultValue;
    property SymbolIndex:Integer read FSymbolIndex write FSymbolIndex;
    property AutoShowPropDialog:Boolean read FAutoShowPropDialog write FAutoShowPropDialog;
  end;

  TAddRectangleMapTool=class(TAddObjectMapTool)
  private
  protected
    procedure InitTool;override;
    procedure RegisterMethodProc; override;
  public
    function IsComplete:Boolean; override;
  published
    procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure DoToolUsed(ASender: TObject; ToolNum: Smallint; X1,
      Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool);
  end;

  TAddCircleMapTool=class(TAddObjectMapTool)
  private
  protected
    procedure InitTool;override;
    procedure RegisterMethodProc; override;
  public
    function IsComplete:Boolean; override;
  published
    procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure DoToolUsed(ASender: TObject; ToolNum: Smallint; X1,
      Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool);
  end;

  TAddArcMapTool=class(TAddObjectMapTool)
  private
  protected
    procedure InitTool;override;
    procedure RegisterMethodProc; override;
  public
    function IsComplete:Boolean; override;
  published
    procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure DoToolUsed(ASender: TObject; ToolNum: Smallint; X1,
      Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool);
  end;
  
  TAddEllipseMapTool=class(TAddObjectMapTool)
  private
  protected
    procedure InitTool;override;
    procedure RegisterMethodProc; override;
  public
    function IsComplete:Boolean; override;
  published
    procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure DoToolUsed(ASender: TObject; ToolNum: Smallint; X1,
      Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool);
  end;
  
  TAddSymbolMapTool=class(TAddObjectMapTool)
  protected
    procedure InitTool;override;
    procedure RegisterMethodProc; override;
  public
    constructor Create(aCollection:TToolList); override;
    function IsComplete:Boolean; override;
  published
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DoToolUsed(ASender: TObject; ToolNum: Smallint; X1,
      Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool);
  end;

  TBreakLineMapTool=class(TLayerMapTool)
  protected
    procedure InitTool;override;
    procedure RegisterMethodProc; override;
  public
    constructor Create(aCollection:TToolList); override;
    function IsComplete:Boolean; override;
  published
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DoToolUsed(ASender: TObject; ToolNum: Smallint; X1,
      Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool);
  end;
  
  TTextEditor=class(TEdit)
  private
    FFt: Feature;
  public
    property Ft:Feature read FFt write FFt;
  end;
  
  TAddTextMapTool=class(TAddObjectMapTool)
  private
    function GetSaveText(InputText:string):string;
    procedure EditorOnChange(Sender:TObject);
    procedure EditorOnExit(Sender:TObject);
  protected
    procedure InitTool;override;
    procedure RegisterMethodProc; override;
    procedure CheckAndCreateEditor;
    procedure EditorToFeature(fts:Feature; Flag:Integer);
    function GetSelectedText:Feature;
  public
    constructor Create(aCollection:TToolList); override;
    function IsComplete:Boolean; override;
  published
    {判断当前工具是否为增加文字工具}
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    {双击时判断是否处于浏览状态，是否有文字被选择，如果有，则将该文字设置为编辑状态}
    procedure DoDblClick(Sender: TObject);
    procedure DoSelectionChanged(Sender: TObject);
    procedure DoToolUsed(ASender: TObject; ToolNum: Smallint; X1,
      Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool);
  end;

  TAddRegionMapTool=class(TAddObjectMapTool)
  private
    IsTracking:Boolean;
    lnWhole:Feature;
    lnSegment:Feature;
    fillSegment:Feature;
    poly:Feature;
    bNeedDeleteFirstPoint:Boolean;
    uLyrManager:TLayerManager;
    FTrackType: TTrackLineType;
    function CanAddPoint(x, y: Integer):Boolean;
    procedure TrackingMove(const x, y: Integer);
    procedure InitUserLayerManager;
  protected
    procedure InitTool;override;
    procedure RegisterMethodProc; override;
  public
    constructor Create(aCollection:TToolList); override;
    destructor Destroy;override;
    function IsComplete:Boolean; override;
    procedure BeginTracking(const v_x, v_y:Double);
    procedure NextTracking(const v_x, v_y:Double);
    procedure EndTracking;
    procedure CancelTracking;
    property TrackType:TTrackLineType read FTrackType write FTrackType;
  published
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure DoMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DoDblClick(Sender: TObject);
    procedure DoToolUsed(ASender: TObject; ToolNum: Smallint; X1,
      Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool);
  end;

  TAddLineMapTool=class(TAddObjectMapTool)
  private
    IsTracking:Boolean;
    lnSegment:Feature;
    FTrackType: TTrackLineType;
    procedure TrackingMove(const x, y: Integer);
  protected
    procedure InitTool;override;
    procedure RegisterMethodProc; override;
  public
    constructor Create(aCollection:TToolList); override;
    destructor Destroy;override;
    function IsComplete:Boolean; override;
    function Cancel:Boolean; override;
    procedure BeginTracking(const v_x, v_y:Double);
    procedure EndTracking;
    procedure CancelTracking;
    property TrackType:TTrackLineType read FTrackType write FTrackType;
  published
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure DoToolUsed(ASender: TObject; ToolNum: Smallint; X1,
      Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool);
  end;
  
  TAddPLineMapTool=class(TAddObjectMapTool)
  private
    IsTracking:Boolean;
    lnWhole:Feature;
    lnSegment:Feature;
    fillSegment:Feature;
    dc:HDC;
    bNeedDeleteFirstPoint:Boolean;
    uLyrManager:TLayerManager;
    FTrackType: TTrackLineType;
    function CanAddPoint(const x, y: Integer):Boolean;
    procedure GetMapDC;
    procedure ReleaseMapDC;
    procedure TrackingMove(const x, y: Integer);
    procedure InitUserLayerManager;
  protected
    procedure InitTool;override;
    procedure RegisterMethodProc; override;
  public
    constructor Create(aCollection:TToolList); override;
    destructor Destroy;override;
    function IsComplete:Boolean; override;
    function Cancel:Boolean; override;
    procedure BeginTracking(const v_x, v_y:Double);
    procedure NextTracking(const v_x, v_y:Double);
    procedure EndTracking;
    procedure CancelTracking;
    property TrackType:TTrackLineType read FTrackType write FTrackType;
  published
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure DoMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DoDblClick(Sender: TObject);
    procedure DoToolUsed(ASender: TObject; ToolNum: Smallint; X1,
      Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool);
  end;

  TFeatureDblClick=procedure (Sender:TObject; Ft:Feature) of object;
  {应该改为浏览工具，该浏览工具的ToolId是固定的}
  TPointSelectTool=class(TCustomMapTool)
  private
    FLayerManager:TLayerManager;
    FOnFeatureDblClick: TFeatureDblClick;
  protected
    procedure InitTool;override;
    procedure RegisterMethodProc; override;
  public
    constructor Create(aCollection:TToolList); override;
    class function IsUserMapTool:Boolean; override;
    destructor Destroy;override;
    function IsComplete:Boolean; override;
    property LayerManager:TLayerManager read FLayerManager; 
  published
    procedure DoDblClick(Sender: TObject);
    property OnFeatureDblClick:TFeatureDblClick read FOnFeatureDblClick
      write FOnFeatureDblClick;
  end;
  
var
  UserToolClasses:TList;

procedure GetAddObjectToolRange(var  Tool_Min, Tool_Max:Integer);
procedure GetEditObjectToolRange(var  Tool_Min, Tool_Max:Integer);
function AddSystemTool(AToolList:TToolList;const aToolId: Smallint;
  const aCursorType, aUserType: Integer; aCursorIcon, aCaption,
  aScript: string; MapX:TMapXObject): TMapXBaseTool;
procedure RegisterSystemTools(AToolList:TToolList; MapX:TMapXObject);
procedure RegisterUserTools(AToolList:TToolList; AMapManager:TMapManager);
procedure RegisterMapXTool(AToolClass:TMapToolClass;
  AToolList:TToolList; AMapManager:TMapManager);

implementation

uses
  BusinessDialogs, StringOperations, MapXStyles, MapXMessages, MapXAPIs,
  AppDebug;

procedure GetAddObjectToolRange(var  Tool_Min, Tool_Max:Integer);
begin
  Tool_Min:=1;
  Tool_Max:=49;
end;

procedure GetEditObjectToolRange(var  Tool_Min, Tool_Max:Integer);
begin
  Tool_Min:=50;
  Tool_Max:=99;
end;

function AddSystemTool(AToolList:TToolList;const aToolId: Smallint;
  const aCursorType, aUserType: Integer; aCursorIcon, aCaption,
  aScript: string; MapX:TMapXObject): TMapXBaseTool;
begin
  Result:=TMapXBaseTool.Create(AToolList);
  Result.MapX:=MapX;
  Result.ToolId:=aToolId;
  Result.UserType:=aUserType;
  Result.CursorType:=aCursorType;
  Result.CursorIcon:=aCursorIcon;
  Result.Caption:=aCaption;
  Result.Script:=aScript;
  AToolList.Add(Result);
end;

procedure RegisterSystemTools(AToolList:TToolList; MapX:TMapXObject);
begin
  AddSystemTool(AToolList, miArrowTool, miDefaultCursor, MAP_TOOL_BROWSER, '', '浏览','', MapX);
  AddSystemTool(AToolList, miZoomInTool, miZoomInCursor, MAP_TOOL_ZOOMIN, '', '放大','', MapX);
  AddSystemTool(AToolList, miZoomOutTool, miZoomOutCursor, MAP_TOOL_ZOOMOUT, '', '缩小','', MapX);
  AddSystemTool(AToolList, miPanTool, miPanCursor, MAP_TOOL_PAN, '', '移动','', MapX);
  AddSystemTool(AToolList, miCenterTool, miCenterCursor, MAP_TOOL_CENTER, '', '居中','', MapX);
  
  AddSystemTool(AToolList, miSelectTool, miDefaultCursor, MAP_TOOL_POINTSELECT, '', '点选','', MapX);
  AddSystemTool(AToolList, miRectSelectTool, miDefaultCursor, MAP_TOOL_RECTSELECT, '', '框选','', MapX);
  AddSystemTool(AToolList, miPolygonSelectTool, miDefaultCursor, MAP_TOOL_POLYSELECT, '', '区域选择','', MapX);
  AddSystemTool(AToolList, miRadiusSelectTool, miDefaultCursor, MAP_TOOL_RADIUSSELECT, '', '放射选择','', MapX);

  AddSystemTool(AToolList, miAddLineTool, miDefaultCursor, MAP_TOOL_ADDLINE, '', '折线','', MapX);
  AddSystemTool(AToolList, miAddPolylineTool, miDefaultCursor, MAP_TOOL_ADDPLINE, '', '多边形','', MapX);
  AddSystemTool(AToolList, miAddRegionTool, miDefaultCursor, MAP_TOOL_ADDREGION, '', '区域','', MapX);
  AddSystemTool(AToolList, miAddPointTool, miDefaultCursor, MAP_TOOL_ADDSYMBOL, '', '点','', MapX);

  AddSystemTool(AToolList, miTextTool, miDefaultCursor, MAP_TOOL_ADDTEXT, '', '文字','', MapX);
  AddSystemTool(AToolList, miLabelTool, miDefaultCursor, MAP_TOOL_ADDLABEL, '', '增加标签','', MapX);
  AddSystemTool(AToolList, miSymbolTool, miDefaultCursor, MAP_TOOL_ADDSYMBOL, '', '显示标签','', MapX);
end;

procedure RegisterUserTools(AToolList:TToolList; AMapManager:TMapManager);
var
  i:Integer;
begin
  for i:=0 to UserToolClasses.Count-1 do
    RegisterMapXTool(TMapToolClass(UserToolClasses.Items[i]),
                     AToolList,
                     AMapManager);
end;

procedure RegisterMapXTool(AToolClass:TMapToolClass;
  AToolList:TToolList; AMapManager:TMapManager);
var
 aItem:TBaseMapTool;
begin
  aItem:=TBaseMapTool(AToolClass.NewInstance);
  aItem.Create(AToolList);
  AToolList.Add(aItem);
  if aItem is TCustomMapTool then
  begin
    with TCustomMapTool(aItem) do
    begin
      MapManager:=AMapManager;
      InitTool;
      RegisterMethodProc;
      BindTool;
    end;
  end;
end;

procedure TrackLine(lnSegment:Feature; const TrackType:TTrackLineType;
  m_x, m_y:Double);
begin
  case TrackType of
    tlCustom : begin
      lnSegment.Parts.Item[1].Item[2].Set_(m_x, m_y);
    end;
    tlHorz   : begin
      m_y:=lnSegment.Parts.Item[1].Item[1].Y;
      lnSegment.Parts.Item[1].Item[2].Set_(m_x, m_y);
    end;
    tlVert   : begin
      m_x:=lnSegment.Parts.Item[1].Item[1].X;
      lnSegment.Parts.Item[1].Item[2].Set_(m_x, m_y);
    end;
  end;
end;

{ TMapXBaseTool }

constructor TMapXBaseTool.Create(aCollection: TToolList);
begin
  inherited Create(aCollection);
end;

function TMapXBaseTool.GetMapX: TMapXObject;
begin
  Result:=FMapX;
end;

function TMapXBaseTool.IsComplete: Boolean;
begin
  Result:=True;
end;

class function TMapXBaseTool.IsUserMapTool: Boolean;
begin
  Result:=False;
end;