图元“复制”“剪切”“粘贴”代码

 

开发环境：VB + MapX

代码：

Private Type FeatureCopyInfo
     Count As Integer
     ftrCopy() As MapXLib.Feature
     Ftrkey() As String
     FtrLayer As MapXLib.Layer
End Type
Private m_udtFtrCopyInfo As FeatureCopyInfo

Private Sub mnuEditCopy_Click()
    Dim ftr As MapXLib.Feature
    Dim ftrs As MapXLib.Features
    Dim intCopyCount As Integer
    Dim pntTextPos As MapXLib.Point
    Dim styText As MapXLib.Style
    Dim strText As String
   
    If Not Map1.Layers.InsertionLayer Is Nothing Then
       intCopyCount = Map1.Layers.InsertionLayer.Selection.Count
       If intCopyCount > 0 Then
         
          m_udtFtrCopyInfo.Count = intCopyCount
          m_udtFtrCopyInfo.FtrLayer = Map1.Layers.InsertionLayer
          ReDim m_udtFtrCopyInfo.ftrCopy(1 To intCopyCount)
          ReDim m_udtFtrCopyInfo.Ftrkey(1 To intCopyCount)
         
          intFtrCount = 0
          Set ftrs = Map1.Layers.InsertionLayer.Selection
          For Each ftr In ftrs
             intFtrCount = intFtrCount + 1
            
             If ftr.Type = miFeatureTypeText Then
                Set pntTextPos = ftr.Point
                Set styText = ftr.Style
                strText = ftr.Caption
               
                Set m_udtFtrCopyInfo.ftrCopy(intFtrCount) = Map1.FeatureFactory.CreateText(potTextPos, strText, miPositionCC, styText)
             Else
                Set m_udtFtrCopyInfo.ftrCopy(intFtrCount) = ftr.Clone
             End If
          Next
       End If
    End If
End Sub
Private Sub mnuEditCut_Click()
    Dim ftr As MapXLib.Feature
    Dim ftrs As MapXLib.Features
   
    If Not Map1.Layers.InsertionLayer Is Nothing Then
       mnuEditCopy_Click
      
       '删除选中图元
       If m_udtFtrCopyInfo.Count > 0 Then
          Set ftrs = Map1.Layers.InsertionLayer.Selection
          For Each ftr In ftrs
              Map1.Layers.InsertionLayer.DeleteFeature ftr
          Next
       End If
    End If
   
End Sub

Private Sub mnuEditPaste_Click()
    Dim intCopyCount As Integer
    Dim ftrNew As MapXLib.Feature
    Dim intScroffset As Integer
    Dim dblMapX As Double
    Dim dblMapY As Double
    Dim sngScrX As Single
    Dim sngScrY As Single
    Dim dblOffxetMapX As Double
    Dim dblOffsetMapY As Double
    Dim i As Integer
   
    intScroffset = 50
    intCopyCount = m_udtFtrCopyInfo.Count
    If (Not Map1.Layers.InsertionLayer Is Nothing) And (intCopyCount > 0) Then
      For i = 1 To intCopyCount
          '偏移复制图元位置，以避免复制图元和复制图元的位置重合
          dblMapX = m_udtFtrCopyInfo.ftrCopy(i).CenterX
          dblMapY = m_udtFtrCopyInfo.ftrCopy(i).CenterY
          Map1.ConvertCoord sngScrX, sngScrY, dblMapX, dblMapY, miMapToScreen
          sngScrX = sngScrX - intScroffset
          sngScrY = sngScrY - intScroffset
          Map1.ConvertCoord sngScrX, sngScrY, dblOffsetMapX, dblOffsetMapY, miScreenToMap
          dblOffsetMapX = dblOffsetMapX - dblMapX
          dblOffsetMapY = dblOffsetMapY - dblMapY
          m_udtFtrCopyInfo.ftrCopy(i).Lffset dblOffsetMapX, dblOffsetMapY
         
          Set ftrNew = Map1.Layers.InsertionLayer.AddFeature(m_udtFtrCopyInfo.ftrCopy(i))
         
          If ftrNew.Type <> miFeatureTypeText Then
          End If
         
          m_udtFtrCopyInfo.ftrCopy(i).Offset -dblOffsetMapX, -dblOffsetMapY
       Next i
    End If
         
End Sub