mapxtools.pas

此代码是关于mapgis的在

procedure TMapXBaseTool.SetMapX(Value: TMapXObject);
begin
  FMapX:=Value;
end;

{ TCustomMapTool }

procedure TCustomMapTool.BindTool;
begin
  CheckMapXObject;
  //如果是MapX系统工具，则不需要绑定//
  if IsUserMapTool then
    MapX.CreateCustomTool(ToolId, ToolType, CursorType);
end;

procedure TCustomMapTool.CheckMapXObject;
begin
  if not Assigned(MapX) then
    raise Exception.Create('Property Value "MapX" is null.');
end;

constructor TCustomMapTool.Create(aCollection:TToolList);
begin
  inherited Create(aCollection);
  FAutoToolId:=True;
  ToolType:=miToolTypeLine;
  CursorType:=miSizeAllCursor;
end;

function TCustomMapTool.GetMapX: TMapXObject;
begin
  Result:=FMapManager.MapX;
end;

procedure TCustomMapTool.InitTool;
begin
  if FAutoToolId then
    ToolId:=Collection.GetNewToolId;
end;

class function TCustomMapTool.IsUserMapTool: Boolean;
begin
  Result:=True;
end;

procedure TCustomMapTool.RegisterMethodProc;
begin
  if MapManager=nil then
    raise Exception.Create('无法注册事件处理过程，因为还没有设置MapManager！');
end;

procedure TCustomMapTool.SetMapX(Value: TMapXObject);
begin
end;

{ TAddRectangleMapTool }

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

end;

procedure TAddRectangleMapTool.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.AddRectangle(X1, Y1, X2, Y2, '', SymbolIndex, False, ID_ACTION_CREATE);
    ShowPropDialog;
    SendMessage(MsgHandle, WM_ENDTRACKING, 0, 0);
  end;
end;

procedure TAddRectangleMapTool.InitTool;
begin
  inherited InitTool;
  Caption:='增加矩形';
  ToolType:=miToolTypeMarquee;
  CursorType:=miDefaultCursor;
  UserType:=MAP_TOOL_ADDRECT;
end;

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

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

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

{ TClipMapTool }

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

end;

procedure TClipMapTool.DoToolUsed(ASender: TObject; ToolNum: Smallint; X1,
  Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
  var EnableDefault: WordBool);
begin
  if ToolNum=ToolId then
  begin
    MapX.Distance(X1, Y1, X2, Y2);
  end;
end;

procedure TClipMapTool.InitTool;
begin
  inherited InitTool;
  Caption:='地图剪切';
  ToolType:=miToolTypeMarquee;
  CursorType:=miDefaultCursor;
  UserType:=MAP_TOOL_CLIPMAP;
end;

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

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

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

{ TRulerMapTool }

procedure TRulerMapTool.DoMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  X2:Double;
  Y2:Double;
  ScreenX:Single;
  ScreenY:Single;
begin
  if (ssLeft in Shift) and IsLocalCurrentTool then
  begin
    ScreenX:=X;
    ScreenY:=Y;
    MapX.ConvertCoord(ScreenX, ScreenY, X2, Y2,miScreenToMap);
    FDistance:=MapX.Distance(m_X1, m_Y1, X2, Y2);
//    RulerToolDistanceChanged;
  end; 
end;

procedure TRulerMapTool.DoToolUsed(ASender: TObject; ToolNum: Smallint; X1,
  Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
  var EnableDefault: WordBool);
begin
  if ToolNum=ToolId then
  begin
    FDistance:=MapX.Distance(X1, Y1, X2, Y2);
    RulerToolUsed;
  end;
end;

procedure TRulerMapTool.InitTool;
begin
  inherited InitTool;
  Caption:='距离测量';
  ToolType:=miToolTypeLine;
  CursorType:=miDefaultCursor;
  UserType:=MAP_TOOL_RULER;
end;

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

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

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

procedure TRulerMapTool.RulerToolUsed;
begin
  SendMessage(MsgHandle, WM_MAPTOOLSEVENT, 0, 0);  
end;

{ TAddTextMapTool }

procedure TAddTextMapTool.CheckAndCreateEditor;
var
  aEdit:TTextEditor;
begin
  if MapX.FindComponent(EditorName)=nil then
  begin
    aEdit:=TTextEditor.Create(MapX);
    aEdit.Name:=EditorName;
    aEdit.Parent:=MapX;
    aEdit.BorderStyle:=bsNone;
  end;
end;

constructor TAddTextMapTool.Create(aCollection: TToolList);
begin
  inherited Create(aCollection);
  FDefaultValue:='文字';
  FSymbolIndex:=0;
end;

procedure TAddTextMapTool.DoDblClick(Sender: TObject);
var
  fts:Feature;
begin
  case MapX.CurrentTool of
    miArrowTool, miSelectTool,
    miRadiusSelectTool, miRectSelectTool,
    miPolygonSelectTool: begin
      fts:=GetSelectedText;
      if fts<>nil then
      begin
        if not fts.Layer.Editable then Exit;
        //判断并创建编辑框
        CheckAndCreateEditor;
        //编辑框显示//
        EditorToFeature(fts, SW_SHOW);
      end;
    end;
  end;
end;

procedure TAddTextMapTool.DoMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  X2:Double;
  Y2:Double;
  ScreenX:Single;
  ScreenY:Single;
  newfts:Feature;
begin
  if (ssLeft in Shift) and IsLocalCurrentTool then
  begin
    //判断并创建编辑框
    CheckAndCreateEditor;
    // 处理图元的位移//
    ScreenX:=X;
    ScreenY:=Y-10;
    MapX.ConvertCoord(ScreenX, ScreenY, X2, Y2,miScreenToMap);
    newfts:=LayerManager.AddText(X2, Y2, GetSaveText(DefaultValue), SymbolIndex, False, ID_ACTION_CREATE);
    //设置Editor到文字//
    EditorToFeature(newfts, SW_SHOW);
  end;
end;

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

end;

procedure TAddTextMapTool.InitTool;
begin
  inherited InitTool;
  Caption:='标注文字';
  ToolType:=miToolTypePoint;
  CursorType:=miTextCursor;
  UserType:=MAP_TOOL_ADDTEXT;
end;

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

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

  pProc3:=DoDblClick;
  MapManager.RegisterEventProc(Self, @pProc3, PROC_DBLCLICK);

  pProc3:=DoSelectionChanged;
  MapManager.RegisterEventProc(Self, @pProc3, PROC_SELECTIONCHANGED);
end;

procedure TAddTextMapTool.EditorToFeature(fts: Feature; Flag: Integer);
var
  aEdit:TTextEditor;
  vXMin, vYMin, vXMax, vYMax:Integer;
begin
  aEdit:=TTextEditor(MapX.FindComponent(EditorName));
  if aEdit<>nil then
  begin
    aEdit.Visible:=False;
    aEdit.Ft:=fts;
    MapManager.ToViewPoint(fts.Bounds.XMin, fts.Bounds.YMin, vXMin, vYMin);
    MapManager.ToViewPoint(fts.Bounds.XMax, fts.Bounds.YMax, vXMax, vYMax);
    aEdit.SetBounds(min(vXMin, vXMax), min(vYMin, vyMax),
                    max(EditorMinWidth, abs(vXMax-vXMin)), abs(vYMax-vYMin));
    aEdit.Text:=Trim(fts.Caption);
    with TFontStyleInfo.Create do
    begin
      try
        Assign(aEdit.Ft.Style);
        ConfigToFont(aEdit.Font);
      finally
        Free;
      end;
    end;
    aEdit.OnChange:=EditorOnChange;
    aEdit.OnExit:=EditorOnExit;
    if Flag=SW_SHOW then
    begin
      aEdit.Show;
      aEdit.SetFocus;
    end;
  end;  
end;

procedure TAddTextMapTool.EditorOnChange(Sender: TObject);
var
  aEdit:TTextEditor;
  vXMin, vYMin, vXMax, vYMax:Integer;
begin
  aEdit:=TTextEditor(Sender);
  if (aEdit<>nil)and(aEdit.Text<>'') then
  begin
    aEdit.Text:=Trim(aEdit.Text);
    aEdit.Ft.Caption:=GetSaveText(aEdit.Text);
    aEdit.Ft.Update(EmptyParam, EmptyParam);
    MapManager.ToViewPoint(aEdit.Ft.Bounds.XMin, aEdit.Ft.Bounds.YMin, vXMin, vYMin);
    MapManager.ToViewPoint(aEdit.Ft.Bounds.XMax, aEdit.Ft.Bounds.YMax, vXMax, vYMax);
    aEdit.SetBounds(min(vXMin, vXMax), min(vYMin, vyMax),
                    max(EditorMinWidth, abs(vXMax-vXMin)), abs(vYMax-vYMin));
  end;
end;

function TAddTextMapTool.GetSelectedText: Feature;
var
  i:Integer;
  mylayer : cmapXlayer;
  myselection : cmapXselection;
begin
  Result:=nil;
  for i:=1 to MapX.layers.Count do
  begin
    mylayer := MapX.layers.Item[i];
    if mylayer.type_=miLayerTypeNormal then
    begin
      myselection := mylayer.Selection;
      if (myselection.Count=1)and(myselection.Item[1].type_=miFeatureTypeText) then
      begin
        Result:=myselection.Item[1];
        Exit;
      end;
    end;
  end;
end;

procedure TAddTextMapTool.EditorOnExit(Sender: TObject);
var
  aEdit:TTextEditor;
begin
  aEdit:=TTextEditor(Sender);
  if aEdit.Text='' then
    aEdit.Ft.Layer.DeleteFeature(aEdit.Ft);
  aEdit.Visible:=False;
end;

procedure TAddTextMapTool.DoSelectionChanged(Sender: TObject);
var
  aEdit:TTextEditor;
begin
  if IsLocalCurrentTool then
  begin
    aEdit:=TTextEditor(Sender);
    aEdit.Ft:=nil;
  end;
end;

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

function TAddTextMapTool.GetSaveText(InputText:string): string;
var
  Len:Integer;
begin
  Len:=AnsiCharCount(InputText)+WideCharCount(InputText)*4;
  Result:=ForceLength(InputText, Len, ' ', True);
end;

{ TAddRegionMapTool }

procedure TAddRegionMapTool.BeginTracking(const v_x, v_y: Double);
begin
  if (not IsComplete)or(TrackLayer=nil) then Exit;
  InitUserLayerManager;
  //绘制当前线段//
  lnSegment := uLyrManager.AddLine(v_x, v_y, v_x, v_y, STYLE_TRACKLINGLINE, False, ID_ACTION_CREATEMEMORY);
  //绘制整条线段//
  lnWhole := uLyrManager.AddLine(v_x, v_y, v_x, v_y, SymbolIndex, False, ID_ACTION_CREATEMEMORY);
  EditFeature:=lnWhole;
  bNeedDeleteFirstPoint:=True;
  IsTracking:=True;
  SendMessage(MsgHandle, WM_BEGINTRACKING, 0, 0);
end;

function TAddRegionMapTool.CanAddPoint(x, y: Integer): Boolean;
var
  LastIndex:Integer;
  pt:Point;
  v_x, v_y:Integer;
  w:Integer;
begin
  Result:=True;
  if (lnWhole<>nil)and(lnWhole.Parts.Count>0)and(lnWhole.Parts.Item[1].Count>0) then
  begin
    w:=1;
    LastIndex:=lnWhole.Parts.Item[1].Count;
    pt:=lnWhole.Parts.Item[1].Item[LastIndex];
    MapManager.ToViewPoint(pt.X, pt.Y, v_x, v_y);
    if ((v_x-w)<x)and(x<(v_x+w))and((v_y-w)<y)and(y<(v_y+w)) then
    begin
      MsgString:='不允许相邻两点坐标重合！';
      SendMessage(MsgHandle, WM_MAPTOOLSEVENT, 0, 0);  
      Result:=False;
    end;
  end;
end;

procedure TAddRegionMapTool.CancelTracking;
begin

end;

constructor TAddRegionMapTool.Create(aCollection: TToolList);
begin
  inherited Create(aCollection);
  uLyrManager:=TLayerManager.Create;
  FDefaultValue:='增加矩形';
  FSymbolIndex:=0;
  TrackType:=tlCustom;
end;

destructor TAddRegionMapTool.Destroy;
begin
  uLyrManager.Free;
  inherited Destroy;
end;

procedure TAddRegionMapTool.DoDblClick(Sender: TObject);
begin
  if IsLocalCurrentTool then EndTracking;
end;

procedure TAddRegionMapTool.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
      NextTracking(m_x, m_y)
    else
    begin
      if not CanAddPoint(x, y) then Exit;
      BeginTracking(m_x, m_y);