mapxtools.pas

此代码是关于mapgis的在

        end;
        if Parts.ItemCount>0 then
          LayerManager.AddLine(Parts, ft.Style, False, ID_ACTION_CREATEMEMORY);
        //点击位置的前半部分形成一条线//
        Parts.Clear; 
        Points:=Parts.Add;
        for i:=1 to PointIndex-1 do
          Points.AddXY(pts.Item[i].X, pts.Item[i].Y);
        Points.AddXY(pt0.x, pt0.y);
        ft1:=LayerManager.AddLine(Parts, ft.Style, False, ID_ACTION_CREATEMEMORY);
        //点击位置的后半部分形成一条线//
        Parts.Clear;
        Points:=Parts.Add;
        Points.AddXY(pt0.x, pt0.y);
        for i:=PointIndex to pts.Count do
          Points.AddXY(pts.Item[i].X, pts.Item[i].Y);
        ft2:=LayerManager.AddLine(Parts, ft.Style, False, ID_ACTION_CREATEMEMORY);
        //删除原有图形//
        LayerManager.Layer.DeleteFeature(ft);
        //选择前半部分图形//
        LayerManager.Layer.Selection.ClearSelection;
        LayerManager.Layer.Selection.Add(ft1);
      finally
        Parts.Free;
      end;
    end;
  end;
end;

procedure TBreakLineMapTool.DoToolUsed(ASender: TObject; ToolNum: Smallint;
  X1, Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
  var EnableDefault: WordBool);
begin

end;

procedure TBreakLineMapTool.InitTool;
begin
  inherited InitTool;
  Caption:='切断折线';
  ToolType:=miToolTypePoint;
  CursorType:=miIconCursor;
  CursorIcon:='Cross1.cur';
  UserType:=MAP_TOOL_BREAKLINE;
end;

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

procedure TBreakLineMapTool.RegisterMethodProc;
var
  pProc1:TMouseEvent;       
  pProc2:TMapXObjectToolUsed;
begin
  pProc1:=DoMouseDown;
  MapManager.RegisterEventProc(Self, @pProc1, PROC_MOUSEDOWN);

  pProc2:=DoToolUsed;
  MapManager.RegisterEventProc(Self, @pProc2, PROC_TOOLUSED);
end;

{ TAddSymbolMapTool }

constructor TAddSymbolMapTool.Create(aCollection: TToolList);
begin
  inherited Create(aCollection);
  FDefaultValue:='标记';
  FSymbolIndex:=0;
end;

procedure TAddSymbolMapTool.DoMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  X2:Double;
  Y2:Double;
  ScreenX:Single;
  ScreenY:Single;
  mstyle:Style;
begin
  if (ssLeft in Shift) and IsLocalCurrentTool then
  begin
    ScreenX:=X;
    ScreenY:=Y;
    MapX.ConvertCoord(ScreenX, ScreenY, X2, Y2,miScreenToMap);
    mstyle:=LayerManager.GetStyleByUserId(SymbolIndex);
    EditFeature:=LayerManager.AddSymbol(X2, Y2, mstyle, False, ID_ACTION_CREATE);
    ShowPropDialog;
    SendMessage(MsgHandle, WM_ENDTRACKING, 0, 0);
  end;
end;

procedure TAddSymbolMapTool.DoToolUsed(ASender: TObject; ToolNum: Smallint;
  X1, Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
  var EnableDefault: WordBool);
begin

end;

procedure TAddSymbolMapTool.InitTool;
begin
  inherited InitTool;
  Caption:='增加标记';
  ToolType:=miToolTypePoint;
  CursorType:=miDefaultCursor;
  UserType:=MAP_TOOL_ADDSYMBOL;
end;

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

procedure TAddSymbolMapTool.RegisterMethodProc;
var
  pProc1:TMouseEvent;       
  pProc2:TMapXObjectToolUsed;
begin
  pProc1:=DoMouseDown;
  MapManager.RegisterEventProc(Self, @pProc1, PROC_MOUSEDOWN);

  pProc2:=DoToolUsed;
  MapManager.RegisterEventProc(Self, @pProc2, PROC_TOOLUSED);
end;

{ TAddRCircleMapTool }

procedure TAddCircleMapTool.DoMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin

end;

procedure TAddCircleMapTool.DoToolUsed(ASender: TObject;
  ToolNum: Smallint; X1, Y1, X2, Y2, Distance: Double; Shift,
  Ctrl: WordBool; var EnableDefault: WordBool);
begin
  if ToolNum=ToolId then
  begin
    if Distance<=0 then Exit;
    EditFeature:=LayerManager.AddCircleRegion(X1, Y1, Distance, SymbolIndex, True, ID_ACTION_CREATE);
    ShowPropDialog;
    SendMessage(MsgHandle, WM_ENDTRACKING, 0, 0);
  end;
end;

procedure TAddCircleMapTool.InitTool;
begin
  inherited InitTool;
  Caption:='增加圆形';
  ToolType:=miToolTypeCircle;
  CursorType:=miDefaultCursor;
  UserType:=MAP_TOOL_ADDCIRCLE;
end;

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

procedure TAddCircleMapTool.RegisterMethodProc;
var
  pProc1:TMouseMoveEvent;       
  pProc2:TMapXObjectToolUsed;
begin
  pProc1:=DoMouseMove;
  MapManager.RegisterEventProc(Self, @pProc1, PROC_MOUSEMOVE);

  pProc2:=DoToolUsed;
  MapManager.RegisterEventProc(Self, @pProc2, PROC_TOOLUSED);
end;

{ TAddEllipseMapTool }

procedure TAddEllipseMapTool.DoMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin

end;

procedure TAddEllipseMapTool.DoToolUsed(ASender: TObject;
  ToolNum: Smallint; X1, Y1, X2, Y2, Distance: Double; Shift,
  Ctrl: WordBool; var EnableDefault: WordBool);
begin
  if ToolNum=ToolId then
  begin
    EditFeature:=LayerManager.AddEllipticalRegion(X1, Y1, X2, Y2, 50, SymbolIndex, True, ID_ACTION_CREATE);
    ShowPropDialog;
    SendMessage(MsgHandle, WM_ENDTRACKING, 0, 0);
  end;
end;

procedure TAddEllipseMapTool.InitTool;
begin
  inherited InitTool;
  Caption:='增加椭圆';
  ToolType:=miToolTypeMarquee;
  CursorType:=miDefaultCursor;
  UserType:=MAP_TOOL_ADDELLIPSE;
end;

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

procedure TAddEllipseMapTool.RegisterMethodProc;
var
  pProc1:TMouseMoveEvent;       
  pProc2:TMapXObjectToolUsed;
begin
  pProc1:=DoMouseMove;
  MapManager.RegisterEventProc(Self, @pProc1, PROC_MOUSEMOVE);

  pProc2:=DoToolUsed;
  MapManager.RegisterEventProc(Self, @pProc2, PROC_TOOLUSED);
end;

{ TAddArcMapTool }

procedure TAddArcMapTool.DoMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin

end;

procedure TAddArcMapTool.DoToolUsed(ASender: TObject; ToolNum: Smallint;
  X1, Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
  var EnableDefault: WordBool);
begin
  if ToolNum=ToolId then
  begin
    if Distance<=0 then Exit;
    EditFeature:=LayerManager.AddCircleRegion(X1, Y1, Distance, SymbolIndex, True, ID_ACTION_CREATE);
    ShowPropDialog;
    SendMessage(MsgHandle, WM_ENDTRACKING, 0, 0);
  end;
end;

procedure TAddArcMapTool.InitTool;
begin
  inherited InitTool;
  Caption:='增加圆形';
  ToolType:=miToolTypeCircle;
  CursorType:=miDefaultCursor;
  UserType:=MAP_TOOL_ADDARC;
end;

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

procedure TAddArcMapTool.RegisterMethodProc;
var
  pProc1:TMouseMoveEvent;       
  pProc2:TMapXObjectToolUsed;
begin
  pProc1:=DoMouseMove;
  MapManager.RegisterEventProc(Self, @pProc1, PROC_MOUSEMOVE);

  pProc2:=DoToolUsed;
  MapManager.RegisterEventProc(Self, @pProc2, PROC_TOOLUSED);
end;

{ TAddObjectMapTool }

constructor TAddObjectMapTool.Create(aCollection: TToolList);
begin
  inherited Create(aCollection);
  FSymbolIndex:=STYLE_MAPDEFAULTSTYLE;
  FAutoShowPropDialog:=True;
end;

procedure TAddObjectMapTool.ShowPropDialog;
begin
  if (EditFeature<>nil) and AutoShowPropDialog then
    LayerManager.ShowPropDialog(EditFeature);
end;

{ TAddLineMapTool }

procedure TAddLineMapTool.BeginTracking(const v_x, v_y: Double);
begin
  if not IsComplete then Exit;
  //绘制当前线段，首次绘制时需要创建线对象，否则设置线的起始和终止点到当前点击的位置//
  lnSegment := LayerManager.AddLine(v_x, v_y, v_x, v_y, SymbolIndex, False, ID_ACTION_CREATEMEMORY);
  IsTracking:=True;
  SendMessage(MsgHandle, WM_BEGINTRACKING, 0, 0);
end;

function TAddLineMapTool.Cancel: Boolean;
begin
  CancelTracking;
end;

procedure TAddLineMapTool.CancelTracking;
begin
  if IsTracking then
  begin
    LayerManager.Layer.DeleteFeature(lnSegment);
    lnSegment:=nil;
    IsTracking:=False;
  end;
end;

constructor TAddLineMapTool.Create(aCollection: TToolList);
begin
  inherited Create(aCollection);
  TrackType:=tlCustom;
end;

destructor TAddLineMapTool.Destroy;
begin
  inherited Destroy;
end;

procedure TAddLineMapTool.DoMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  m_x, m_y:Double;
begin
  if (ssLeft in Shift)and(not (ssDouble in Shift)) and IsLocalCurrentTool then
  begin
    MapManager.ToMapPoint(x, y, m_x, m_y);
    if IsTracking then
      EndTracking
    else
      BeginTracking(m_x, m_y);
  end
  else if (ssRight in Shift) then
  begin
    if IsTracking then Cancel;
  end;
end;

procedure TAddLineMapTool.DoMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if IsLocalCurrentTool then TrackingMove(X, Y);
end;

procedure TAddLineMapTool.DoToolUsed(ASender: TObject; ToolNum: Smallint;
  X1, Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
  var EnableDefault: WordBool);
begin

end;

procedure TAddLineMapTool.EndTracking;
begin
  EditFeature:=lnSegment;
  IsTracking:=False;
  ShowPropDialog;
  SendMessage(MsgHandle, WM_ENDTRACKING, 0, 0);
end;

procedure TAddLineMapTool.InitTool;
begin
  inherited InitTool;
  Caption:='增加线段';
  ToolType:=miToolTypePoint;
  CursorType:=miDefaultCursor;
  UserType:=MAP_TOOL_ADDLINE;
end;

function TAddLineMapTool.IsComplete: Boolean;
begin
  Result:=not IsTracking;
end;

procedure TAddLineMapTool.RegisterMethodProc;
var
  pProc1:TMouseEvent;       
  pProc2:TMapXObjectToolUsed;
  pProc5:TMouseMoveEvent;
begin
  pProc1:=DoMouseDown;
  MapManager.RegisterEventProc(Self, @pProc1, PROC_MOUSEDOWN);

  pProc2:=DoToolUsed;
  MapManager.RegisterEventProc(Self, @pProc2, PROC_TOOLUSED);

  pProc5:=DoMouseMove;
  MapManager.RegisterEventProc(Self, @pProc5, PROC_MOUSEMOVE);  
end;

procedure TAddLineMapTool.TrackingMove(const x, y: Integer);
var
  m_x, m_y:Double;
begin
  if IsComplete then Exit;
  MapManager.ToMapPoint(x, y, m_x, m_y);
  If (lnSegment<>nil)and(not VarIsEmpty(lnSegment)) Then
  begin
    TrackLine(lnSegment, FTrackType, m_x, m_y);
    lnSegment.Update(EmptyParam, EmptyParam);
  end;
end;

{ TPointSelectTool }

constructor TPointSelectTool.Create(aCollection: TToolList);
begin
  inherited Create(aCollection);
  FLayerManager:=TLayerManager.Create;
  FAutoToolId:=False;
end;

destructor TPointSelectTool.Destroy;
begin
  FLayerManager.Free;
  inherited Destroy;
end;

procedure TPointSelectTool.DoDblClick(Sender: TObject);
var
  ALyr:Layer;
begin
  if MapX.CurrentTool=ToolId then
  begin
    ALyr:=MapManager.GetSingleSelectedLayer;
    if (ALyr=nil)or(ALyr.Selection.Count<>1) then
      Exit;
    with FLayerManager do
    begin
      MapManager:=Self.MapManager;
      Layer:=ALyr;
      if Layer.Editable then
        ShowPropDialog(ALyr.Selection.Item[1])
      else if Assigned(FOnFeatureDblClick) then
        FOnFeatureDblClick(Self, ALyr.Selection.Item[1]);
    end;
  end;
end;

procedure TPointSelectTool.InitTool;
begin
  inherited InitTool;
  Caption:='点选';
  ToolId:=miSelectTool;
  ToolType:=miToolTypePoint;
  CursorType:=miDefaultCursor;
  UserType:=MAP_TOOL_DBLCLICK;
end;

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

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

procedure TPointSelectTool.RegisterMethodProc;
var
  pProc1:TNotifyEvent;       
begin
  pProc1:=DoDblClick;
  MapManager.RegisterEventProc(Self, @pProc1, PROC_DBLCLICK);
end;

initialization
  if UserToolClasses=nil then
  begin
    UserToolClasses:=TList.Create;
    UserToolClasses.Add(TRulerMapTool);
    UserToolClasses.Add(TAddSymbolMapTool);
    UserToolClasses.Add(TAddTextMapTool);
    UserToolClasses.Add(TAddRegionMapTool);
    UserToolClasses.Add(TAddPLineMapTool);
    UserToolClasses.Add(TAddRectangleMapTool);
    UserToolClasses.Add(TAddCircleMapTool);
    UserToolClasses.Add(TAddEllipseMapTool);
    UserToolClasses.Add(TAddArcMapTool);
    UserToolClasses.Add(TAddLineMapTool);

    UserToolClasses.Add(TBreakLineMapTool);
    UserToolClasses.Add(TClipMapTool);
    UserToolClasses.Add(TPointSelectTool);
  end;

finalization
  if UserToolClasses<>nil then
  begin
    UserToolClasses.Free;
    UserToolClasses:=nil;
    DebugLog.Add('DB500TS-C', ['MapXTools: UserToolClasses.Free']);
  end;
end.