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

最新推荐文章于 2025-02-18 09:14:55 发布

原创最新推荐文章于 2025-02-18 09:14:55 发布 · 1.1k 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#integer #string #each #vb

MapX 专栏收录该内容

23 篇文章

订阅专栏

本文介绍了一个使用VB结合MapX组件实现的地图编辑功能，包括复制、剪切和粘贴地图元素的操作流程及其实现代码。针对不同类型的图元进行了区分处理，并实现了偏移粘贴以避免粘贴位置与原始位置重合。

开发环境：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