VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "EditLayer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Public PolyColor As Long
Dim m_grid As SnappingGrid
Dim m_map As MapObjects2.Map

'多邊形序列
Dim m_polys() As MapObjects2.Polygon

'選擇的多邊形或頂點
Dim m_selPoly As Integer
Dim m_selVertex As Integer

'刪除選定的多變形或頂點
Sub DeleteSelection()
  '若存在,則刪除被選中的頂點
  If m_selVertex >= 0 Then
    Set pts = m_polys(m_selPoly).Parts(0)
    If pts.Count > 4 Then
      pts.Remove m_selVertex
      m_selVertex = m_selVertex - 1
    Else
      m_selVertex = -1
    End If
    
    Refresh
    Exit Sub
  End If
  
  '若存在,則刪除被選中的多邊形
  If m_selPoly >= 0 Then
    Set m_polys(m_selPoly) = Nothing
    numPolys = UBound(m_polys) - 1
    Set Last = m_polys(numPolys)
    ReDim Preserve m_polys(numPolys)
    If Not Last Is Nothing Then
      Set m_polys(m_selPoly) = Last
    End If
    
    If m_selPoly >= numPolys Then
      '選擇下一個多邊形
      m_selPoly = m_selPoly - 1
    End If
    
    Refresh
  End If
End Sub

Sub Draw()
  '此方法需置于AfterTrackingLayerDraw事件處理代碼中
  Dim sym As New MapObjects2.Symbol
  sym.Color = PolyColor
  sym.Style = moGrayFill
  For i = 0 To UBound(m_polys) - 1
    m_map.DrawShape m_polys(i), sym
  Next i
  
  '繪制選擇的多邊形或頂點
  sym.SymbolType = moPointSymbol
  sym.Size = 7
  sym.Color = m_grid.Color
  
  If m_selPoly >= 0 Then
    Set pts = m_polys(m_selPoly).Parts(0)
    For Each p In pts
      m_map.DrawShape p, sym
    Next p
    sym.Color = moYellow
    If m_selVertex >= 0 Then m_map.DrawShape pts(m_selVertex), sym
  End If
End Sub

'將編輯圖層中的圖形存儲在Shape文件中
Sub ExportToShapefile(pathName As String)
  Dim fileName As String, dirName As String
  SplitPath pathName, dirName, fileName
  Dim dc As New MapObjects2.DataConnection
  dc.Database = dirName
  '檢測是否連接成功
  If Not dc.Connect Then Exit Sub
  
  Dim tDesc As New MapObjects2.TableDesc
  Dim gs As GeoDataset
  Set gs = dc.AddGeoDataset(fileName, moPolygon, tDesc)
  '錯誤的文件名
  If gs Is Nothing Then Exit Sub
   
  Dim layer As New MapObjects2.MapLayer
  Set layer.GeoDataset = gs
  Set recs = layer.Records
  Set shpFld = recs.Fields("Shape")
  
  '向文件中寫入編輯圖層中的多邊形
  For i = 0 To UBound(m_polys) - 1
    recs.AddNew
    shpFld.Value = m_polys(i)
    recs.Update
  Next i
End Sub

'類初始化代碼
Sub Initialize(Map As MapObjects2.Map, grid As SnappingGrid)
  Set m_map = Map
  Set m_grid = grid
End Sub

'刷新TrackingLayer
Sub Refresh()
  m_map.TrackingLayer.Refresh True
End Sub

'選擇pt附近的多邊形頂點
Function SelectVertex(pt As MapObjects2.Point) As Boolean
  tol = m_map.ToMapDistance(100)
  If m_selPoly >= 0 Then
    m_selVertex = -1
    Set pts = m_polys(m_selPoly).Parts(0)
    For Each v In pts
      m_selVertex = m_selVertex + 1
      If v.DistanceTo(pt) < tol Then
        Refresh
        SelectVertex = True
        Exit Function
      End If
    Next v
  End If
  
  SelectVertex = False
End Function

'調整多邊形,以適合當前網格
Sub SnapPolygons()
  For i = 0 To UBound(m_polys) - 1
    Set m_polys(i) = m_grid.SnapPolygon(m_polys(i), m_map)
  Next i
  Refresh
End Sub

'向多邊形中添加頂點
Sub SplitPolygon(pt As MapObjects2.Point)
  If m_selPoly = -1 Then Exit Sub
  
  Dim pts As MapObjects2.Points
  Set pts = m_polys(m_selPoly).Parts(0)
  tol = m_map.ToMapDistance(100)
  
  pts.Add pts(0)
  For i = 1 To pts.Count - 1
    dist = pt.DistanceToSegment(pts(i - 1), pts(i))
    If dist <= tol Then
      m_grid.SnapPoint pt, m_map
      '插入頂點
      pts.Insert i, pt
      '選擇這個頂點
      m_selVertex = i
      Refresh
      Exit Sub
    End If
  Next i
End Sub

'選中pt所在的多邊形
Function SelectPolygon(pt As MapObjects2.Point) As Integer
  '若找到多邊形,則返回1
  '判斷是否有頂點被選中
  If SelectVertex(pt) Then
    SelectPolygon = 1
    Exit Function
  End If
  
  '或選中一個多邊形
  m_selPoly = -1
  m_selVertex = -1
  For i = 0 To UBound(m_polys) - 1
    If m_polys(i).IsPointIn(pt) Then
      m_selPoly = i
      Exit For
    End If
  Next i

  Refresh
  SelectPolygon = 0
End Function

'移動選中的頂點到pt處
Sub MoveVertex(pt As MapObjects2.Point)
  If m_selPoly >= 0 And m_selVertex >= 0 Then
    m_grid.SnapPoint pt, m_map
    Set Poly = m_polys(m_selPoly)
    Dim pts As Points
    Set pts = Poly.Parts(0)
    pts.Set m_selVertex, pt
    
    '若選中的頂點是多邊形頂點
    '則移動它的同時也要移動最后一個頂點
    '以保證多邊形的閉合
    If m_selVertex = 0 Then pts.Set pts.Count - 1, pt
    '若選中的是多邊形的最后一個頂點，也要同時移動第一個
    If m_selVertex = pts.Count - 1 Then pts.Set 0, pt
    Refresh
  End If
End Sub

'向編輯圖層中添加一個多邊形
Sub AddPolygon()
  Dim Poly As MapObjects2.Polygon
  Set Poly = m_map.TrackPolygon
  
  '跟蹤輸入的多邊形，并加入多邊形序列中
  If Not Poly Is Nothing Then
    numPolys = UBound(m_polys)
    ReDim Preserve m_polys(numPolys + 1)
    Set m_polys(numPolys) = m_grid.SnapPolygon(Poly, m_map)
    
    '選中新的多邊形
    m_selPoly = numPolys
    m_selVertex = -1
    
    Refresh
  End If
End Sub

'將多邊形定點顯示為一個小矩形
Function VertexHandle() As MapObjects2.Rectangle
  If m_selVertex = -1 Then Exit Function
  
  Set pt = m_polys(m_selPoly).Parts(0).Item(m_selVertex)
  r = m_map.ToMapDistance(60)
  Dim rect As New MapObjects2.Rectangle
  rect.Left = pt.x - r
  rect.Right = pt.x + r
  rect.Top = pt.y + r
  rect.Bottom = pt.y - r
  
  Set VertexHandle = rect
End Function

'類初始化代碼
Private Sub Class_Initialize()
  ReDim m_polys(0)
  PolyColor = moCyan
  m_selPoly = -1
  m_selVertext = -1
End Sub