移动选择的地理要素？

用选择工具选择一多边形、直线、点
将其选择集拖动到任意地方，松开鼠标数据集更新为拖放后的数据


要实现移动功能？
请版主
帮忙
谢谢

一些函数，很难看懂，不过我想还应该有点用处
Private Declare Function GdiLineTo Lib "gdi32" Alias "LineTo" (ByVal hDC As Long, ByVal x1 As Long, ByVal y1 As Long) As Long
Private Declare Function GdiMoveTo Lib "gdi32" Alias "MoveToEx" (ByVal hDC As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal pp As Long) As Long
Private Declare Function GdiRectangle Lib "gdi32" Alias "Rectangle" (ByVal hDC As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SetROP2 Lib "gdi32" (ByVal hDC As Long, ByVal nDrawMode As Long) As Long
Private Const R2_NOTXORPEN = 10

Dim m_map As MapObjects2.map
Dim picmap As PictureBox
Dim m_hDC As Long
Dim m_hWnd As Long
Dim m_xMin As Integer, m_yMin As Integer
Dim m_xMax As Integer, m_yMax As Integer
Dim m_xPrev As Integer
Dim m_yPrev As Integer

Dim prevP As New MapObjects2.point
Dim prevP1 As New MapObjects2.point
Dim pointNew As New MapObjects2.point
''''''
Dim mprevP As New MapObjects2.point
Dim mprevP1 As New MapObjects2.point
Dim mpointNew As New MapObjects2.point

Dim osnapShape As Object


Dim Loc As New MapObjects2.point
Dim newX As Single
Dim newY As Single
  
Function GetRecsCount(recs As MapObjects2.Recordset) As Long
recs.MoveFirst
Do While Not recs.EOF
recs.MoveNext
Loop
GetRecsCount = recs.Count
recs.MoveFirst
End Function
Function SetMap(map As MapObjects2.map)
Set m_map = map
End Function
Function DDrawLinePan(map As MapObjects2.map, Line As Object, x As Long, y As Long)
Dim a As Long, B As Long
Dim pts As MapObjects2.points
   Dim partj As Long
  
    Dim newX As Single, newY As Single
    Dim p As MapObjects2.point
    
    For Each pts In Line.Parts
    partj = 0
    For Each p In pts
    map.FromMapPoint p, newX, newY
    a = map.Parent.ScaleX(newX, vbTwips, vbPixels)
    B = map.Parent.ScaleY(newY, vbTwips, vbPixels)
    If partj = 0 Then
    GdiMoveTo m_hDC, a + x, B + y, 0
    Else
    GdiLineTo m_hDC, a + x, B + y
    End If
    partj = partj + 1
    Next p
    Next pts
End Function
Function DDrawLinePan1(map As MapObjects2.map, Line As Object, x As Long, y As Long)
Dim a As Long, B As Long
Dim pts As MapObjects2.points
   Dim partj As Long
  
    Dim newX As Single, newY As Single
    Dim p As MapObjects2.point
    Dim eCount As Long
    
    For Each pts In Line.Parts
    partj = 0
    eCount = pts.Count
    For Each p In pts
    map.FromMapPoint p, newX, newY
    a = map.Parent.ScaleX(newX, vbTwips, vbPixels)
    B = map.Parent.ScaleY(newY, vbTwips, vbPixels)
    If partj = 0 Then
    GdiMoveTo m_hDC, a + x, B + y, 0
    Else
    GdiLineTo m_hDC, a + x, B + y
    End If
    partj = partj + 1
    
    If partj = eCount Then
    map.FromMapPoint pts.Item(0), newX, newY
    a = map.Parent.ScaleX(newX, vbTwips, vbPixels)
    B = map.Parent.ScaleY(newY, vbTwips, vbPixels)
    GdiLineTo m_hDC, a + x, B + y
    End If
    
    Next p
    Next pts
End Function
Function DDrawPolygonPan(map As MapObjects2.map, Line As MapObjects2.Polygon, x As Long, y As Long)
Dim a As Long, B As Long
Dim pts As MapObjects2.points
   Dim partj As Long
  
    Dim newX As Single, newY As Single
    Dim p As MapObjects2.point
    
    For Each pts In Line.Parts
    partj = 0
    For Each p In pts
    map.FromMapPoint p, newX, newY
    a = map.Parent.ScaleX(newX, vbTwips, vbPixels)
    B = map.Parent.ScaleY(newY, vbTwips, vbPixels)
    If partj = 0 Then
    GdiMoveTo m_hDC, a + x, B + y, 0
    Else
    GdiLineTo m_hDC, a + x, B + y
    End If
    partj = partj + 1
    Next p
    Next pts
End Function

Function DDrawLinePanSel(map As MapObjects2.map, Line As Object, x As Long, y As Long, selPart As Long, selVer As Long)
Dim a As Long, B As Long
Dim pts As MapObjects2.points
    Dim partj As Long
    
    
    Dim newX As Single, newY As Single
    Dim p As MapObjects2.point
    
    Dim ppp As Long
    partj = 0
    For Each pts In Line.Parts
    ppp = 0
    For Each p In pts
    map.FromMapPoint p, newX, newY
    a = map.Parent.ScaleX(newX, vbTwips, vbPixels)
    B = map.Parent.ScaleY(newY, vbTwips, vbPixels)
    If partj = selPart And ppp = selVer Then
    
    If ppp = 0 Then
    GdiMoveTo m_hDC, a + x, B + y, 0
    Else
    GdiLineTo m_hDC, a + x, B + y
    End If
    
    Else
    
    If ppp = 0 Then
    GdiMoveTo m_hDC, a, B, 0
    Else
    GdiLineTo m_hDC, a, B
    End If
    
    End If
    
    
    ppp = ppp + 1
    Next p
    partj = partj + 1
    Next pts
End Function

Function DDrawLinePanSel1(map As MapObjects2.map, Line As Object, x As Long, y As Long, selPart As Long, selVer As Long)
    
    Dim a As Long, B As Long
    Dim pts As MapObjects2.points
    Dim partj As Long
    
    Dim newX As Single, newY As Single
    Dim p As MapObjects2.point
    
    Dim eCount As Long
    
    
    Dim ppp As Long
    partj = 0
    For Each pts In Line.Parts
    ppp = 0
    eCount = pts.Count
    For Each p In pts
    map.FromMapPoint p, newX, newY
    a = map.Parent.ScaleX(newX, vbTwips, vbPixels)
    B = map.Parent.ScaleY(newY, vbTwips, vbPixels)
    
    If partj = selPart And ppp = selVer Then
        If ppp = 0 Then
            GdiMoveTo m_hDC, a + x, B + y, 0
            Else
            GdiLineTo m_hDC, a + x, B + y
        End If
    Else
        If ppp = 0 Then
        GdiMoveTo m_hDC, a, B, 0
        Else
        GdiLineTo m_hDC, a, B
        End If
    End If
    
    
    
    If eCount = ppp - 1 Then
        
        map.FromMapPoint pts(0), newX, newY
        a = map.Parent.ScaleX(newX, vbTwips, vbPixels)
        B = map.Parent.ScaleY(newY, vbTwips, vbPixels)
        
        If partj = selPart And ppp = selVer Then
           GdiLineTo m_hDC, a + x, B + y
        Else
           GdiLineTo m_hDC, a, B
        End If
    End If
    
    ppp = ppp + 1
    
    Next p
    partj = partj + 1
    Next pts
End Function

Function DDrawLinesStart(map As MapObjects2.map, layerNum As Long, lineNum As Long, point As MapObjects2.point)
  Set m_map = map
  m_hWnd = m_map.hwnd
  SetCapture (m_hWnd)
  m_hDC = GetDC(m_hWnd)
  SetROP2 m_hDC, R2_NOTXORPEN
    
  Dim Line As Object 'As MapObjects2.line
  GetLineFromMapFalse map, Line, layerNum, lineNum
    
    map.FromMapPoint point, newX, newY
    prevP.x = map.Parent.ScaleX(newX, vbTwips, vbPixels)
    prevP.y = map.Parent.ScaleX(newY, vbTwips, vbPixels)
    prevP1.x = prevP.x
    prevP1.y = prevP.y
End Function
Function DDrawPolygonStart(map As MapObjects2.map, layerNum As Long, lineNum As Long, point As MapObjects2.point)
  
  Set m_map = map
  m_hWnd = m_map.hwnd
  SetCapture (m_hWnd)
  m_hDC = GetDC(m_hWnd)
  SetROP2 m_hDC, R2_NOTXORPEN
    
  Dim Line As Object 'As MapObjects2.line
  GetLineFromMapFalse map, Line, layerNum, lineNum
    
    map.FromMapPoint point, newX, newY
    prevP.x = map.Parent.ScaleX(newX, vbTwips, vbPixels)
    prevP.y = map.Parent.ScaleX(newY, vbTwips, vbPixels)
    prevP1.x = prevP.x
    prevP1.y = prevP.y
End Function

Sub DLineMove(map As MapObjects2.map, recs As MapObjects2.Recordset, point As MapObjects2.point)
  
  Dim Line As MapObjects2.Line
  Set Line = recs.Fields("Shape").Value
    
    Dim pts As MapObjects2.points
    Dim p As MapObjects2.point
    Dim partj As Long
    partj = 0
    
    Dim x, y As Single
    Dim dx, dy As Single
    
    Set Loc = prevP1
    m_map.FromMapPoint Loc, newX, newY
    dx = m_map.Parent.ScaleX(newX, vbTwips, vbPixels)
    dy = m_map.Parent.ScaleY(newY, vbTwips, vbPixels)
    Set Loc = prevP
    m_map.FromMapPoint Loc, newX, newY
    x = m_map.Parent.ScaleX(newX, vbTwips, vbPixels)
    y = m_map.Parent.ScaleY(newY, vbTwips, vbPixels)
    dx = dx - x
    dy = dy - y
    
    For Each pts In Line.Parts
    partj = 0
    For Each p In pts
    Set Loc = p
    m_map.FromMapPoint Loc, newX, newY
    x = m_map.Parent.ScaleX(newX, vbTwips, vbPixels)
    y = m_map.Parent.ScaleY(newY, vbTwips, vbPixels)
    If partj = 0 Then
    GdiMoveTo m_hDC, x + dx, y + dy, 0
    Else
    GdiLineTo m_hDC, x + dx, y + dy
    End If
    partj = partj + 1
    Next p
    Next pts
    
    Set Loc = point
    m_map.FromMapPoint Loc, newX, newY
    dx = m_map.Parent.ScaleX(newX, vbTwips, vbPixels)
    dy = m_map.Parent.ScaleY(newY, vbTwips, vbPixels)
    Set Loc = prevP
    m_map.FromMapPoint Loc, newX, newY
    x = m_map.Parent.ScaleX(newX, vbTwips, vbPixels)
    y = m_map.Parent.ScaleY(newY, vbTwips, vbPixels)
    dx = dx - x
    dy = dy - y
    
    For Each pts In Line.Parts
    partj = 0
    For Each p In pts
    Set Loc = p
    m_map.FromMapPoint Loc, newX, newY
    x = m_map.Parent.ScaleX(newX, vbTwips, vbPixels)
    y = m_map.Parent.ScaleY(newY, vbTwips, vbPixels)
    If partj = 0 Then
    GdiMoveTo m_hDC, x + dx, y + dy, 0
    Else
    GdiLineTo m_hDC, x + dx, y + dy
    End If
    partj = partj + 1
    Next p
    Next pts
    
    prevP1.x = point.x
    prevP1.y = point.y
End Sub

Sub DLineEnd(map As MapObjects2.map, recs As MapObjects2.Recordset, point As MapObjects2.point)
  
  
  Dim Line As MapObjects2.Line
  Set Line = recs.Fields("Shape").Value
    
    Dim pts As MapObjects2.points
    Dim p As MapObjects2.point
    Dim partj As Long
    partj = 0
    
    Dim x, y As Single
    Dim dx, dy As Single
    
    Set Loc = prevP1
    m_map.FromMapPoint Loc, newX, newY
    dx = m_map.Parent.ScaleX(newX, vbTwips, vbPixels)
    dy = m_map.Parent.ScaleY(newY, vbTwips, vbPixels)
    Set Loc = prevP
    m_map.FromMapPoint Loc, newX, newY
    x = m_map.Parent.ScaleX(newX, vbTwips, vbPixels)
    y = m_map.Parent.ScaleY(newY, vbTwips, vbPixels)
    dx = dx - x
    dy = dy - y
    
    For Each pts In Line.Parts
    partj = 0
    For Each p In pts
    Set Loc = p
    m_map.FromMapPoint Loc, newX, newY
    x = m_map.Parent.ScaleX(newX, vbTwips, vbPixels)
    y = m_map.Parent.ScaleY(newY, vbTwips, vbPixels)
    If partj = 0 Then
    GdiMoveTo m_hDC, x + dx, y + dy, 0
    Else
    GdiLineTo m_hDC, x + dx, y + dy
    End If
    partj = partj + 1
    Next p
    Next pts
    
    ReleaseDC m_hWnd, m_hDC
End Sub

Sub DragStart(Rect As MapObjects2.Rectangle, map As MapObjects2.map, x As Single, y As Single)
  Set m_map = map
  m_hWnd = m_map.hwnd
  m_hDC = GetDC(m_hWnd)
  SetROP2 m_hDC, R2_NOTXORPEN
    
  MapRectToPixels Rect, m_xMin, m_yMin, m_xMax, m_yMax
  
  GdiRectangle m_hDC, m_xMin, m_yMin, m_xMax, m_yMax
  
  m_xPrev = m_map.Parent.ScaleX(x, vbTwips, vbPixels)
  m_yPrev = m_map.Parent.ScaleY(y, vbTwips, vbPixels)
  
End Sub

Private Sub MapRectToPixels(r As MapObjects2.Rectangle, xMin As Integer, yMin As Integer, xMax As Integer, yMax As Integer)
  Dim p As New MapObjects2.point
  Dim xc As Single, yc As Single
  
  p.x = r.Left
  p.y = r.Top
  m_map.FromMapPoint p, xc, yc
  
  xMin = m_map.Parent.ScaleX(xc, vbTwips, vbPixels)
  yMin = m_map.Parent.ScaleY(yc, vbTwips, vbPixels)

  p.x = r.Right
  p.y = r.Bottom
  m_map.FromMapPoint p, xc, yc
  
  xMax = m_map.Parent.ScaleX(xc, vbTwips, vbPixels)
  yMax = m_map.Parent.ScaleY(yc, vbTwips, vbPixels)
End Sub

Sub PixelsRectToMap(xMin As Integer, yMin As Integer, xMax As Integer, yMax As Integer, r As MapObjects2.Rectangle)
  Dim xc As Single, yc As Single
  
  xc = m_map.Parent.ScaleX(xMin, vbPixels, vbTwips)
  yc = m_map.Parent.ScaleY(yMin, vbPixels, vbTwips)
  Dim p As MapObjects2.point
  Set p = m_map.ToMapPoint(xc, yc)
  r.Left = p.x
  r.Top = p.y

  xc = m_map.Parent.ScaleX(xMax, vbPixels, vbTwips)
  yc = m_map.Parent.ScaleY(yMax, vbPixels, vbTwips)
  Set p = m_map.ToMapPoint(xc, yc)
  r.Right = p.x
  r.Bottom = p.y
End Sub

Function CalOsnapPoint1(Map1 As MapObjects2.map, point As MapObjects2.point, layerNum As Long, outterMinDis As Double, selLayerNum As Long, selVertex As Long)
  
  selLayerNum = layerNum
  selVertex = -1
  Dim f As Double
  f = Map1.ToMapDistance(outterMinDis)
  Dim recsCount As Long
  Dim recs As MapObjects2.Recordset
  Set recs = Map1.Layers(layerNum).Records
  Dim pointr As MapObjects2.point
  
  recsCount = GetRecsCount(recs)
  recs.MoveFirst
  Dim i As Long
  
  For i = 0 To recsCount - 1
  If recs.EOF Then Exit For
  Set pointr = recs.Fields("Shape").Value
  If pointr.DistanceTo(point) < f Then
  selVertex = i
  Exit For
 
  End If
  recs.MoveNext
  Next
  selVertex = selVertex
  
End Function

Function CalOsnapPoint(Map1 As MapObjects2.map, point As MapObjects2.point, layerNum As Long, outterMinDis As Double, selLayerNum As Long, selVertex As Long)
  On Error Resume Next
  Dim sT As New VBA.Collection
  
  'Exit Function
  selLayerNum = -1
  selVertex = -1
  Dim f As Double
  f = Map1.ToMapDistance(outterMinDis)
  Dim recsCount As Long
  Dim recs As MapObjects2.Recordset
  If Map1.Layers.Count <= layerNum Then Exit Function
  Set recs = Map1.Layers(layerNum).Records
  Dim pointr As MapObjects2.point
  
  
  recsCount = GetRecsCount(recs)
  recs.MoveFirst
  Dim i As Long
  
  For i = 0 To recsCount - 1
  If recs.EOF Then Exit For
  If (recs.Fields("Shape") Is Nothing) Then Exit Function
  Set pointr = recs.Fields("Shape").Value
  If pointr.DistanceTo(point) < f Then
      selVertex = i
      sT.Add CStr(i)
      'Exit For
      Map1.FlashShape pointr, 2
  End If
  recs.MoveNext
  Next
  selVertex = selVertex
  Dim typea As Long
  typea = 1
  GetOnlyId sT, selVertex, typea, selLayerNum, pointr, recs
  If selVertex < 0 Then
  selLayerNum = -1
  Else
  selLayerNum = layerNum
  End If
  Exit Function
s1:
End Function

Function CalOsnapPoints(Map1 As MapObjects2.map, point As MapObjects2.point, layerNum As Long, outterMinDis As Double, selLayerNum As Long, selVertex As Long)
  On Error Resume Next
  Dim sT As New VBA.Collection
  
  'Exit Function
  selLayerNum = -1
  selVertex = -1
  Dim f As Double
  f = Map1.ToMapDistance(outterMinDis)
  Dim recsCount As Long
  Dim recs As MapObjects2.Recordset
  If Map1.Layers.Count <= layerNum Then Exit Function
  Set recs = Map1.Layers(layerNum).Records
  Dim pointr As MapObjects2.point
  Dim pointrs As MapObjects2.points
  
  recsCount = GetRecsCount(recs)
  recs.MoveFirst
  Dim i As Long
  
  For i = 0 To recsCount - 1
  If recs.EOF Then Exit For
  If (recs.Fields("Shape") Is Nothing) Then Exit Function
  Set pointrs = recs.Fields("Shape").Value
  Set pointr = pointrs.Item(0)
  If pointr.DistanceTo(point) < f Then
      selVertex = i
      sT.Add CStr(i)
      'Exit For
      Map1.FlashShape pointr, 2
  End If
  recs.MoveNext
  Next
  selVertex = selVertex
  Dim typea As Long
  typea = 1
  GetOnlyId sT, selVertex, typea, selLayerNum, pointr, recs
  If selVertex < 0 Then
  selLayerNum = -1
  Else
  selLayerNum = layerNum
  End If
  Exit Function
s1:
  
End Function

Function CalOsnapPoints1(Map1 As MapObjects2.map, point As MapObjects2.point, layerNum As Long, outterMinDis As Double, selLayerNum As Long, selVertex As Long)
  On Error GoTo exit1
  selLayerNum = layerNum
  selVertex = -1
  Dim f As Double
  f = Map1.ToMapDistance(outterMinDis)
  Dim recsCount As Long
  Dim recs As MapObjects2.Recordset
  Set recs = Map1.Layers(layerNum).Records
  Dim pointr As MapObjects2.point
  Dim pointrs As MapObjects2.points
  recsCount = GetRecsCount(recs)
  recs.MoveFirst
  Dim i As Long
  For i = 0 To recsCount - 1
  If recs.EOF Then Exit For
  If (recs.Fields("Shape") Is Nothing) Then Exit Function
  Set pointrs = recs.Fields("Shape").Value
  
  Set pointr = pointrs.Item(0)
  
  If pointr.DistanceTo(point) < f Then
  selVertex = i
  Exit For
 
  End If
  recs.MoveNext
  Next
  selVertex = selVertex
exit1:
  
End Function

Function DDrawLinesMove(map As MapObjects2.map, layerNum As Long, lineNum As Long, point As MapObjects2.point)


  Set m_map = map
  SetROP2 m_hDC, R2_NOTXORPEN
  
  Dim dx As Long, dy As Long
  dx = prevP1.x - prevP.x
  dy = prevP1.y - prevP.y
  
  Dim Line As Object
  GetLineFromMapFalse map, Line, layerNum, lineNum
  
  DDrawLinePan map, Line, dx, dy
  
  map.FromMapPoint point, newX, newY
  prevP1.x = map.Parent.ScaleX(newX, vbTwips, vbPixels)
  prevP1.y = map.Parent.ScaleX(newY, vbTwips, vbPixels)
  dx = prevP1.x - prevP.x
  dy = prevP1.y - prevP.y
  
  DDrawLinePan map, Line, dx, dy
  
End Function

Function DDrawPolygonMove(map As MapObjects2.map, layerNum As Long, lineNum As Long, point As MapObjects2.point)
  Set m_map = map
  SetROP2 m_hDC, R2_NOTXORPEN
  
  Dim dx As Long, dy As Long
  dx = prevP1.x - prevP.x
  dy = prevP1.y - prevP.y
  
  Dim Line As Object
  GetLineFromMapFalse map, Line, layerNum, lineNum
  
  DDrawLinePan1 map, Line, dx, dy
  
  map.FromMapPoint point, newX, newY
  prevP1.x = map.Parent.ScaleX(newX, vbTwips, vbPixels)
  prevP1.y = map.Parent.ScaleX(newY, vbTwips, vbPixels)
  dx = prevP1.x - prevP.x
  dy = prevP1.y - prevP.y
  
  DDrawLinePan1 map, Line, dx, dy
End Function

Function DDrawLinesMoveSel(map As MapObjects2.map, layerNum As Long, lineNum As Long, point As MapObjects2.point, selPart As Long, selVer As Long)

  Set m_map = map
  SetROP2 m_hDC, R2_NOTXORPEN
  
  Dim dx As Long, dy As Long
  dx = prevP1.x - prevP.x
  dy = prevP1.y - prevP.y
  
  Dim Line As Object 'mapobjects2.line
  GetLineFromMapFalse map, Line, layerNum, lineNum
  
  DDrawLinePanSel map, Line, dx, dy, selPart, selVer
  
  map.FromMapPoint point, newX, newY
  prevP1.x = map.Parent.ScaleX(newX, vbTwips, vbPixels)
  prevP1.y = map.Parent.ScaleX(newY, vbTwips, vbPixels)
  dx = prevP1.x - prevP.x
  dy = prevP1.y - prevP.y
  
  DDrawLinePanSel map, Line, dx, dy, selPart, selVer
  
End Function

Function DDrawPolygonMoveSel(map As MapObjects2.map, layerNum As Long, lineNum As Long, point As MapObjects2.point, selPart As Long, selVer As Long)

  Set m_map = map
  SetROP2 m_hDC, R2_NOTXORPEN
  
  Dim dx As Long, dy As Long
  dx = prevP1.x - prevP.x
  dy = prevP1.y - prevP.y
  
  Dim Line As Object 'mapobjects2.line
  GetLineFromMapFalse map, Line, layerNum, lineNum
  
  DDrawLinePanSel1 map, Line, dx, dy, selPart, selVer
  
  map.FromMapPoint point, newX, newY
  prevP1.x = map.Parent.ScaleX(newX, vbTwips, vbPixels)
  prevP1.y = map.Parent.ScaleX(newY, vbTwips, vbPixels)
  dx = prevP1.x - prevP.x
  dy = prevP1.y - prevP.y
  
  DDrawLinePanSel1 map, Line, dx, dy, selPart, selVer
  
End Function

Function DDrawEnd()
  
  SetROP2 m_hDC, R2_NOTXORPEN
    
  ReleaseDC m_hWnd, m_hDC
  ReleaseCapture
End Function

Function DDrawLinesEnd(map As MapObjects2.map, layerNum As Long, lineNum As Long, point As MapObjects2.point)

  Set m_map = map
  SetROP2 m_hDC, R2_NOTXORPEN
  
  Dim dx As Long, dy As Long
  dx = prevP1.x - prevP.x
  dy = prevP1.y - prevP.y
  
  Dim Line As Object 'As MapObjects2.line
  GetLineFromMapFalse map, Line, layerNum, lineNum
  
  DDrawLinePan map, Line, dx, dy
    
  ReleaseDC m_hWnd, m_hDC
  ReleaseCapture
    
End Function

Function DDrawLineBegin(map As MapObjects2.map, x1 As Single, y1 As Single, x2 As Single, y2 As Single)
  
  Set m_map = map
  m_hWnd = m_map.hwnd
  SetCapture (m_hWnd)
  m_hDC = GetDC(m_hWnd)
  SetROP2 m_hDC, R2_NOTXORPEN

Dim a, B, c, d As Integer
  
a = m_map.Parent.ScaleX(x1, vbTwips, vbPixels)
B = m_map.Parent.ScaleY(y1, vbTwips, vbPixels)
c = m_map.Parent.ScaleX(x2, vbTwips, vbPixels)
d = m_map.Parent.ScaleY(y2, vbTwips, vbPixels)

GdiMoveTo m_hDC, a, B, 0
GdiLineTo m_hDC, c, d

prevP.x = a
prevP.y = B
prevP1.x = c
prevP1.y = d

End Function

Sub DDrawARectangle(m_hDC As Long, a As Long, B As Long)
GdiMoveTo m_hDC, a - 3, B - 3, 0
GdiLineTo m_hDC, a + 3, B - 3
GdiLineTo m_hDC, a + 3, B + 3
GdiLineTo m_hDC, a - 3, B + 3
GdiLineTo m_hDC, a - 3, B - 3
End Sub

Function DDrawPointEnd(map As MapObjects2.map, x1 As Single, y1 As Single)
Set m_map = map
SetROP2 m_hDC, R2_NOTXORPEN
DDrawARectangle m_hDC, prevP.x, prevP.y
ReleaseDC m_hWnd, m_hDC
ReleaseCapture
End Function

Function DDrawPointBegin(map As MapObjects2.map, x1 As Single, y1 As Single)
 Set m_map = map
  m_hWnd = m_map.hwnd
  SetCapture (m_hWnd)
  m_hDC = GetDC(m_hWnd)
  SetROP2 m_hDC, R2_NOTXORPEN
  Dim a21 As Long
  Dim bb As Long
a21 = m_map.Parent.ScaleX(x1, vbTwips, vbPixels)
bb = m_map.Parent.ScaleY(y1, vbTwips, vbPixels)
DDrawARectangle m_hDC, a21, bb
prevP.x = a21
prevP.y = bb
End Function

Function DDrawLineMove(map As MapObjects2.map, x1 As Single, y1 As Single, x2 As Single, y2 As Single)
 Set m_map = map
 SetROP2 m_hDC, R2_NOTXORPEN
Dim a, B, c, d As Integer
a = m_map.Parent.ScaleX(x1, vbTwips, vbPixels)
B = m_map.Parent.ScaleY(y1, vbTwips, vbPixels)
c = m_map.Parent.ScaleX(x2, vbTwips, vbPixels)
d = m_map.Parent.ScaleY(y2, vbTwips, vbPixels)

GdiMoveTo m_hDC, prevP.x, prevP.y, 0
GdiLineTo m_hDC, prevP1.x, prevP1.y
GdiMoveTo m_hDC, a, B, 0
GdiLineTo m_hDC, c, d

prevP.x = a
prevP.y = B
prevP1.x = c
prevP1.y = d

End Function

Function DDrawLineEnd(map As MapObjects2.map)
Set m_map = map

SetROP2 m_hDC, R2_NOTXORPEN
GdiMoveTo m_hDC, prevP.x, prevP.y, 0
GdiLineTo m_hDC, prevP1.x, prevP1.y

ReleaseDC m_hWnd, m_hDC
ReleaseCapture

End Function

Function DDrawPointMove(map As MapObjects2.map, x As Single, y As Single)
Set m_map = map
 SetROP2 m_hDC, R2_NOTXORPEN
Dim a As Long
Dim B As Long
a = m_map.Parent.ScaleX(x, vbTwips, vbPixels)
B = m_map.Parent.ScaleY(y, vbTwips, vbPixels)
DDrawARectangle m_hDC, prevP.x, prevP.y
DDrawARectangle m_hDC, a, B
prevP.x = a
prevP.y = B
End Function

Function DragFinish(x As Single, y As Single) As MapObjects2.Rectangle
  
  GdiRectangle m_hDC, m_xMin, m_yMin, m_xMax, m_yMax
  ReleaseDC m_hWnd, m_hDC
  
  Dim r As New MapObjects2.Rectangle
  PixelsRectToMap m_xMin, m_yMin, m_xMax, m_yMax, r
  Set DragFinish = r
End Function

Sub DragMove(x As Single, y As Single)
  Dim xNext As Long, yNext As Long
  
  
  xNext = m_map.Parent.ScaleX(x, vbTwips, vbPixels)
  yNext = m_map.Parent.ScaleY(y, vbTwips, vbPixels)
    
  GdiRectangle m_hDC, m_xMin, m_yMin, m_xMax, m_yMax
  m_xMin = m_xMin + (xNext - m_xPrev)
  m_xMax = m_xMax + (xNext - m_xPrev)
  m_yMin = m_yMin + (yNext - m_yPrev)
  m_yMax = m_yMax + (yNext - m_yPrev)
  
  GdiRectangle m_hDC, m_xMin, m_yMin, m_xMax, m_yMax
  m_xPrev = xNext
  m_yPrev = yNext
  
End Sub

Sub DLineStart(map As MapObjects2.map, recs As MapObjects2.Recordset, point As MapObjects2.point)
  
  Dim Line As MapObjects2.Line
  Set Line = recs.Fields("Shape").Value

  Set m_map = map
  m_hWnd = m_map.hwnd
  m_hDC = GetDC(m_hWnd)
  SetROP2 m_hDC, R2_NOTXORPEN
    
    Dim pts As MapObjects2.points
    Dim p As MapObjects2.point
    Dim partj As Long
    partj = 0
    
    Dim x, y As Single
    
    For Each pts In Line.Parts
    partj = 0
    For Each p In pts
    Set Loc = p
    m_map.FromMapPoint Loc, newX, newY
    x = m_map.Parent.ScaleX(newX, vbTwips, vbPixels)
    y = m_map.Parent.ScaleY(newY, vbTwips, vbPixels)
    
    If partj = 0 Then
    GdiMoveTo m_hDC, x, y, 0
    Else
    GdiLineTo m_hDC, x, y
    End If
    partj = partj + 1
    Next p
    Next pts
    prevP.x = point.x
    prevP.y = point.y
    prevP1.x = point.x
    prevP1.y = point.y
End Sub

斑竹太伟大了!谢谢!

很有帮助

为版主加油

斑竹好！

<P>真不错。谢谢</P>

thanks