⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mapxtools.pas

📁 此代码是关于mapgis的在
💻 PAS
📖 第 1 页 / 共 4 页
字号:
    end;
  end;
end;

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

procedure TAddRegionMapTool.DoMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (ssLeft in Shift) and IsLocalCurrentTool then
  begin
  end;
end;

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

procedure TAddRegionMapTool.EndTracking;
var
  pts:CMapXPoints;
  mstyle : style;//样式
begin
  pts:=lnWhole.Parts.Item[1];
  if pts.Count<3 then
    WarningAbort('提示', '少于3个点,不能闭和区域!');
    
  mstyle := LayerManager.GetStyleByUserId(SymbolIndex);
  poly:=MapX.FeatureFactory.CreateRegion(Pts, mstyle);
  EditFeature:=LayerManager.Layer.AddFeature(poly, EmptyParam);

  uLyrManager.Layer.DeleteFeature(lnWhole);
  uLyrManager.Layer.DeleteFeature(lnSegment);
  uLyrManager.Layer.DeleteFeature(fillSegment);

  lnSegment:=nil;
  fillSegment:=nil;
  lnWhole:=nil;

  IsTracking:=False;

  ShowPropDialog;
  SendMessage(MsgHandle, WM_ENDTRACKING, 0, 0);
end;

procedure TAddRegionMapTool.InitTool;
begin
  inherited InitTool;
  Caption:='增加多边形';
  ToolType:=miToolTypePoint;
  CursorType:=miDefaultCursor;
  UserType:=MAP_TOOL_ADDREGION;
end;

procedure TAddRegionMapTool.InitUserLayerManager;
begin
  uLyrManager.MapManager:=LayerManager.MapManager;
  uLyrManager.Layer:=LayerManager.Layer;
end;

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

procedure TAddRegionMapTool.NextTracking(const v_x, v_y: Double);
var
  pt1,pt2:CMapXPoint;
begin
  if IsComplete then Exit;
  //绘制当前线段//
  lnSegment.Parts.Item[1].Item[1].Set_(v_x, v_y);
  lnSegment.Parts.Item[1].Item[2].Set_(v_x, v_y);
  lnSegment.Update(EmptyParam, EmptyParam);
  //加入新的点//
  lnWhole.Parts.Item[1].AddXY(v_x, v_y, EmptyParam);
  lnWhole.Update(EmptyParam, EmptyParam);
  //刚一创建的时候是两个点,因此需要删除一个//
  if bNeedDeleteFirstPoint then
  begin
    lnWhole.Parts.Item[1].Remove(1);
    lnWhole.Update(EmptyParam, EmptyParam);
    bNeedDeleteFirstPoint:=False;
  end;
  //如果为绘制多边形并且整条线段的点数大于两个,绘制封闭线段//
  if lnWhole.Parts.Item[1].Count>1 then
  begin
    //如果填充线为空,说明还没有填充线,这时要创建填充线,然后设置填充线的起点//
    //为整条直线的起点,终点为整条线的重点;否则设置终点为整条线的终点//
    If (fillSegment=nil)or(VarIsEmpty(fillSegment))  Then
    begin
      pt1:=lnWhole.Parts.Item[1].Item[1];
      pt2:=lnWhole.Parts.Item[1].Item[lnWhole.Parts.Item[1].Count];
      InitUserLayerManager;
      fillSegment := uLyrManager.AddLine(pt1.X, pt1.Y, pt2.X, pt2.Y, STYLE_TRACKLINGLINE, False, ID_ACTION_CREATEMEMORY);
    end
    Else
    begin
      fillSegment.Parts.Item[1].Item[2].Set_(v_x, v_y);
      fillSegment.Update(EmptyParam, EmptyParam);
    end;
  end;
  SendMessage(MsgHandle, WM_NEXTTRACKING, 0, 0);
end;
procedure TAddRegionMapTool.RegisterMethodProc;
var
  pProc1:TMouseEvent;
  pProc2:TMapXObjectToolUsed;
  pProc3:TNotifyEvent;
  pProc4:TMouseEvent;
  pProc5:TMouseMoveEvent;
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);

  pProc4:=DoMouseUp;
  MapManager.RegisterEventProc(Self, @pProc4, PROC_MOUSEUP);

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

procedure TAddRegionMapTool.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
    //设置当前线的最后一点为Pt//
    TrackLine(lnSegment, FTrackType, m_x, m_y);
//    lnSegment.Parts.Item[1].Item[2].Set_(m_x, m_y);
    lnSegment.Update(EmptyParam, EmptyParam);
    //设置封闭曲线的最后一点为pt//
    if (fillSegment<>nil)and(not VarIsEmpty(fillSegment)) then
    begin
      fillSegment.Parts.Item[1].Item[2].Set_(m_x, m_y);
      fillSegment.Update(EmptyParam, EmptyParam);
    end;
  end;
end;

{ TAddPLineMapTool }

procedure TAddPLineMapTool.BeginTracking(const v_x, v_y: Double);
begin
  if not IsComplete then Exit;
  InitUserLayerManager;
  //绘制当前线段,首次绘制时需要创建线对象,否则设置线的起始和终止点到当前点击的位置//
  lnSegment := uLyrManager.AddLine(v_x, v_y, v_x, v_y, STYLE_TRACKLINGLINE, False, ID_ACTION_CREATEMEMORY);
  //绘制整条线段,首次绘制时需要创建线对象,否则把当前点击的点增加到线上//
  lnWhole := LayerManager.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 TAddPLineMapTool.CanAddPoint(const 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;
function TAddPLineMapTool.Cancel: Boolean;
begin
  CancelTracking; 
end;

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

constructor TAddPLineMapTool.Create(aCollection: TToolList);
begin
  inherited Create(aCollection);
  uLyrManager:=TLayerManager.Create;
  TrackType:=tlCustom;
end;

destructor TAddPLineMapTool.Destroy;
begin
  ReleaseMapDC;
  uLyrManager.Free;
  inherited Destroy;
end;

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

procedure TAddPLineMapTool.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);
    end;
  end
  else if (ssRight in Shift) then
  begin
    if IsTracking then Cancel;
  end;
end;

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

procedure TAddPLineMapTool.DoMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (ssLeft in Shift) and IsLocalCurrentTool then
  begin
  end;
end;

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

procedure TAddPLineMapTool.EndTracking;
var
  pt:Point;
begin
  pt:=lnWhole.Parts.Item[1]._Item(1);
  if lnWhole.Parts.Item[1].Count<3 then
    WarningAbort('提示', '少于3个点,不能闭和多边形!');
  lnWhole.Parts.Item[1].AddXY(pt.X, pt.Y, EmptyParam);
  lnWhole.Update(EmptyParam, EmptyParam);

  uLyrManager.Layer.DeleteFeature(lnSegment);
  uLyrManager.Layer.DeleteFeature(fillSegment);

  lnSegment:=nil;
  fillSegment:=nil;
  lnWhole:=nil;

  IsTracking:=False;
  ReleaseMapDC;

  ShowPropDialog;
  SendMessage(MsgHandle, WM_ENDTRACKING, 0, 0);
end;

procedure TAddPLineMapTool.GetMapDC;
begin
  if dc=0 then dc:=GetDC(MapX.hWnd);
end;

procedure TAddPLineMapTool.InitTool;
begin
  inherited InitTool;
  Caption:='增加折线';
  ToolType:=miToolTypePoint;
  CursorType:=miDefaultCursor;
  UserType:=MAP_TOOL_ADDPLINE;
end;

procedure TAddPLineMapTool.InitUserLayerManager;
begin
  uLyrManager.MapManager:=LayerManager.MapManager;
  uLyrManager.Layer:=LayerManager.Layer;
end;

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

procedure TAddPLineMapTool.NextTracking(const v_x, v_y: Double);
var
  pt1,pt2:CMapXPoint;
begin
  if IsComplete then Exit;
  //绘制当前线段//
  lnSegment.Parts.Item[1].Item[1].Set_(v_x, v_y);
  lnSegment.Parts.Item[1].Item[2].Set_(v_x, v_y);
  lnSegment.Update(EmptyParam, EmptyParam);
  //加入新的点//
  lnWhole.Parts.Item[1].AddXY(v_x, v_y, EmptyParam);
  lnWhole.Update(EmptyParam, EmptyParam);
  //刚一创建的时候是两个点,因此需要删除一个//
  if bNeedDeleteFirstPoint then
  begin
    lnWhole.Parts.Item[1].Remove(1);
    lnWhole.Update(EmptyParam, EmptyParam);
    bNeedDeleteFirstPoint:=False;
  end;
  //如果为绘制多边形并且整条线段的点数大于两个,绘制封闭线段//
  if lnWhole.Parts.Item[1].Count>1 then
  begin
    //如果填充线为空,说明还没有填充线,这时要创建填充线,然后设置填充线的起点//
    //为整条直线的起点,终点为整条线的重点;否则设置终点为整条线的终点//
    If (fillSegment=nil)or(VarIsEmpty(fillSegment))  Then
    begin
      pt1:=lnWhole.Parts.Item[1].Item[1];
      pt2:=lnWhole.Parts.Item[1].Item[lnWhole.Parts.Item[1].Count];
      InitUserLayerManager;
      fillSegment := uLyrManager.AddLine(pt1.X, pt1.Y, pt2.X, pt2.Y, STYLE_TRACKLINGLINE, False, ID_ACTION_CREATEMEMORY)
    end
    Else
    begin
      fillSegment.Parts.Item[1].Item[2].Set_(v_x, v_y);
      fillSegment.Update(EmptyParam, EmptyParam);
    end;
  end;
  SendMessage(MsgHandle, WM_NEXTTRACKING, 0, 0);
end;

procedure TAddPLineMapTool.RegisterMethodProc;
var
  pProc1:TMouseEvent;       
  pProc2:TMapXObjectToolUsed;
  pProc3:TNotifyEvent;
  pProc4:TMouseEvent;
  pProc5:TMouseMoveEvent;
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);

  pProc4:=DoMouseUp;
  MapManager.RegisterEventProc(Self, @pProc4, PROC_MOUSEUP);

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

procedure TAddPLineMapTool.ReleaseMapDC;
begin
  if dc<>0 then
  begin
    ReleaseDC(MapX.hWnd, dc);
    dc:=0;
  end;
end;

procedure TAddPLineMapTool.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
    //设置当前线的最后一点为Pt//
    TrackLine(lnSegment, FTrackType, m_x, m_y);
//    lnSegment.Parts.Item[1].Item[2].Set_(m_x, m_y);
    lnSegment.Update(EmptyParam, EmptyParam);
    //设置封闭曲线的最后一点为pt//
    if (fillSegment<>nil)and(not VarIsEmpty(fillSegment)) then
    begin
      fillSegment.Parts.Item[1].Item[2].Set_(m_x, m_y);
      fillSegment.Update(EmptyParam, EmptyParam);
    end;
  end;
end;

{ TBreakLineMapTool }

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

procedure TBreakLineMapTool.DoMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i:Integer;
  X1:Double;
  Y1:Double;
  X2:Double;
  Y2:Double;
  Len:Double;
  ScreenX:Single;
  ScreenY:Single;
  pt0:TAny2DPoint;
  ft,ft1,ft2:Feature;
  pts:Points;
  PartIndex, PointIndex:Integer;
  Parts:TMapPartList;
  Points:TMapPointList;
begin
  if (ssLeft in Shift) and IsLocalCurrentTool then
  begin
    if LayerManager.Layer.Selection.Count<1 then
    begin
      MyDefInformation('请选择要切断的折线!');
      Exit;
    end;
    if LayerManager.Layer.Selection.Count>1 then
    begin
      MyDefInformation(ErrorSingleLine);
      Exit;
    end;
    ft:=LayerManager.Layer.Selection.Item[1];
    if ft.type_<>miFeatureTypeLine then
    begin
      MyDefInformation(ErrorSingleLine);
      Exit;
    end;
    ScreenX:=X-2;
    ScreenY:=Y-2;
    MapX.ConvertCoord(ScreenX, ScreenY, X1, Y1,miScreenToMap);
    ScreenX:=X+2;
    ScreenY:=Y+2;
    MapX.ConvertCoord(ScreenX, ScreenY, X2, Y2,miScreenToMap);
    Len:=abs(X2-X1);
    //取得点击位置的地图坐标//
    ScreenX:=X;
    ScreenY:=Y;
    MapX.ConvertCoord(ScreenX, ScreenY, X2, Y2,miScreenToMap);
    //找出最近的一条线段//
    if GetNearestLine(ft, X2, Y2, Len, PartIndex, PointIndex, pt0) then
    begin
      pts:=ft.Parts.Item[PartIndex];
      //将整个图形分成两部分//
      Parts:=TMapPartList.Create;
      try            
        //将除选种的Part外的部分形成一条线//
        Parts.Clear;
        for i:=1 to PartIndex-1 do
        begin
          Points:=Parts.Add;
          Points.LoadFromPoints(ft.Parts.Item[i]);
        end;
        for i:=PartIndex+1 to ft.Parts.Count do
        begin
          Points:=Parts.Add;
          Points.LoadFromPoints(ft.Parts.Item[i]);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -