sulin
路人甲
路人甲
  • 注册日期2003-07-28
  • 发帖数158
  • QQ
  • 铜币501枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:7632回复:21

MO中怎样实现UNDO和REDO?

楼主#
更多 发布于:2003-09-15 17:28
MO在编辑中,怎么使已知图层处于编辑状态,怎么实现编辑的UNDO和REDO?
请各路大侠指教!<img src="images/post/smile/dvbbs/em10.gif" /><img src="images/post/smile/dvbbs/em09.gif" />
喜欢0 评分0
tim
tim
路人甲
路人甲
  • 注册日期2003-07-31
  • 发帖数37
  • QQ
  • 铜币200枚
  • 威望0点
  • 贡献值0点
  • 银元0个
1楼#
发布于:2003-09-18 16:43
mo没有这方面的功能,只能靠自己编了,很复杂。希望你早日实现并给我们共享一下!
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15947
  • QQ554730525
  • 铜币25339枚
  • 威望15364点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
2楼#
发布于:2003-09-22 10:24
我来试试。
在程序里找了几段程序,大家看看吧,撤消和恢复编辑操作的实现,
大家仔细看后面那几个主要的操作函数啦,应该有点帮助!
Private Sub MO_MENU_UNDO_Click()
Mod_IF.EditUnDo
End Sub

'//////撤消/////
Public Function EditUnDo()
CalculateSetSel -1, -1, -1
If clsMapT.CanUndo Then
    clsMapT.Undo frmMain.Map1, 1
End If
frmMain.Map1.Refresh
End Function
注意程序是截取下来的,所以模块的划分大家可以不理会,主要看看思路了。
Function CanUndo() As Boolean
CanUndo = False
CanUndo = undoNow - undoTimesBegin
End Function



Private Function UUAddLine(map As MapObjects2.map) 'undo
On Error GoTo exit1
Dim typea, layerNum As Long
 typea = popType
 layerNum = popInt
 popObject
 
Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 'recs.Edit
 
 recs.MoveFirst
 
 GetRecsCount recs
 
 recs.Edit
 
 Dim aae As Long
 For aae = 1 To recs.count - 1
 recs.MoveNext
 Next
 'recs.Edit
 recs.Delete

 'recs.Update
 recs.StopEditing
 Refresh map
exit1:
End Function

Private Function UUAddPoint(map As MapObjects2.map) 'undo
On Error GoTo exit1
Dim typea, layerNum As Long
 typea = popType
 layerNum = popInt
 popObject
 
Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 
 
 GetRecsCount recs
 
 recs.MoveFirst
 recs.Edit
 
 Dim aae As Long
 For aae = 1 To recs.count - 1
 recs.MoveNext
 Next
 recs.Delete
 'recs.Edit

' recs.Update
 recs.StopEditing
 
 Refresh map
exit1:
End Function


Private Function UUAddShape(map As MapObjects2.map) 'undo
On Error GoTo exit1
Dim typea, layerNum As Long
 typea = popType
 layerNum = popInt
 popObject
 
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 
 
 GetRecsCount recs
 
 recs.MoveFirst
 recs.Edit
 
 Dim aae As Long
 For aae = 1 To recs.count - 1
 recs.MoveNext
 Next
 
 recs.Delete
' recs.Edit

' recs.Update
 recs.StopEditing
 
 Refresh map
exit1:
End Function



[此贴子已经被作者于2003-9-22 10:26:42编辑过]
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15947
  • QQ554730525
  • 铜币25339枚
  • 威望15364点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
3楼#
发布于:2003-09-22 10:24
Private Function UUMovePoint(map As MapObjects2.map) 'undo
    On Error GoTo exit1
    Dim layerNum As Long
    Dim vertexNum As Long
    Dim x As Double
    Dim Y As Double
    Dim typea As Long
    typea = popType
    vertexNum = popInt
    layerNum = popInt
    
    Dim recs As MapObjects2.Recordset
    Set recs = map.Layers(layerNum).Records
    recs.Edit
    
    recs.MoveFirst
    Dim i As Long
    For i = 0 To vertexNum - 1
    recs.MoveNext
    Next
    recs.Edit
    Dim pointea As MapObjects2.point
    Set pointea = recs.Fields("Shape").Value
    pointNew.Y = popAndPushDouble(pointea.Y)
    pointNew.x = popAndPushDouble(pointea.x)
    Set recs.Fields("Shape").Value = pointNew
    recs.Update
    recs.StopEditing
    popEnd
    Refresh map
    'popEnd
exit1:
End Function

Private Function UUMovePoints(map As MapObjects2.map) 'undo
    On Error GoTo exit1
    Dim layerNum As Long
    Dim vertexNum As Long
    Dim x As Double
    Dim Y As Double
    Dim typea As Long
    typea = popType
    vertexNum = popInt
    layerNum = popInt
    
    Dim recs As MapObjects2.Recordset
    Set recs = map.Layers(layerNum).Records
    recs.Edit
    
    recs.MoveFirst
    Dim i As Long
    For i = 0 To vertexNum - 1
    recs.MoveNext
    Next
    recs.Edit
    Dim pointea As MapObjects2.point
    Dim pointeas As MapObjects2.points
    Set pointeas = recs.Fields("Shape").Value
    Set pointea = pointeas.item(0)
    pointNew.Y = popAndPushDouble(pointea.Y)
    pointNew.x = popAndPushDouble(pointea.x)
    Dim ps As New MapObjects2.points
    ps.Add pointNew
    
    Set recs.Fields("Shape").Value = ps
    recs.Update
    recs.StopEditing
    popEnd
    Refresh map
    'popEnd
exit1:
End Function

Private Function URMovePoint(map As MapObjects2.map) 'redo
    On Error GoTo exit1
    Dim layerNum As Long
    Dim vertexNum As Long
    Dim x As Double
    Dim Y As Double
    Dim typea As Long
    
    typea = pipType
    layerNum = pipInt
    vertexNum = pipInt
    
    Dim recs As MapObjects2.Recordset
    Set recs = map.Layers(layerNum).Records
    recs.Edit
    
    recs.MoveFirst
    Dim i As Long
    For i = 0 To vertexNum - 1
    recs.MoveNext
    Next
    recs.Edit
    Dim pointea As MapObjects2.point
    Set pointea = recs.Fields("Shape").Value
    pointNew.x = pipAndPushDouble(pointea.x)
    pointNew.Y = pipAndPushDouble(pointea.Y)
    Set recs.Fields("Shape").Value = pointNew
    recs.Update
    recs.StopEditing
    Dim layerCount As Long
    layerCount = 0
    Refresh map
    pipEnd
exit1:
End Function

Private Function URMovePoints(map As MapObjects2.map) 'redo
    On Error GoTo exit1
    Dim layerNum As Long
    Dim vertexNum As Long
    Dim x As Double
    Dim Y As Double
    Dim typea As Long
    
    typea = pipType
    layerNum = pipInt
    vertexNum = pipInt
    
    Dim recs As MapObjects2.Recordset
    Set recs = map.Layers(layerNum).Records
    recs.Edit
    
    recs.MoveFirst
    Dim i As Long
    For i = 0 To vertexNum - 1
    recs.MoveNext
    Next
    recs.Edit
    Dim pointea As MapObjects2.point
    Dim pointeas As MapObjects2.points
    Set pointeas = recs.Fields("Shape").Value
    Set pointea = pointeas.item(0)
    pointNew.x = pipAndPushDouble(pointea.x)
    pointNew.Y = pipAndPushDouble(pointea.Y)
    Dim ps As New MapObjects2.points
    ps.Add pointNew
    Set recs.Fields("Shape").Value = ps
    recs.Update
    recs.StopEditing
    Dim layerCount As Long
    layerCount = 0
    Refresh map
    pipEnd
exit1:
End Function

Private Function UULineDelPoint(map As MapObjects2.map) 'undo
On Error GoTo exit1
Dim layerNum As Long, m_selLine As Long, m_selPart As Long, m_selVertex As Long
Dim x As Double, Y As Double
Dim typea As Long

 typea = popType
 m_selVertex = popInt
 m_selPart = popInt
 m_selLine = popInt
 layerNum = popInt
 Set m_map = map
 
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 recs.MoveFirst
 recs.Edit
 
 Dim i As Long
 For i = 0 To m_selLine - 1
 recs.MoveNext
 Next
 
 recs.Edit
 
 Dim Line As MapObjects2.Line
 Set Line = recs.Fields("Shape").Value
 Dim xOld As Double
 Dim yOld As Double
 Dim xold1 As Double
 Dim yold1 As Double
 
 xold1 = 0
 yold1 = 0
 yOld = popAndPushDouble(yold1)
 xOld = popAndPushDouble(xold1)
 popEnd
 Dim lineNew As New MapObjects2.Line
 CopyLineAddPoint lineNew, Line, m_selPart, m_selVertex, xOld, yOld
 Set recs.Fields("Shape").Value = lineNew
 Set lineNew = Nothing
 
 recs.Update
 recs.StopEditing
 Refresh map
exit1:

End Function
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15947
  • QQ554730525
  • 铜币25339枚
  • 威望15364点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
4楼#
发布于:2003-09-22 10:24
Private Function UUPolygonDelPoint(map As MapObjects2.map) 'undo
On Error GoTo exit1
Dim layerNum As Long, m_selLine As Long, m_selPart As Long, m_selVertex As Long
Dim x As Double, Y As Double
Dim typea As Long

 typea = popType
 m_selVertex = popInt
 m_selPart = popInt
 m_selLine = popInt
 layerNum = popInt
 Set m_map = map
 
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 recs.MoveFirst
 recs.Edit
 
 Dim i As Long
 For i = 0 To m_selLine - 1
 recs.MoveNext
 Next
 
 recs.Edit
 
 Dim Line As MapObjects2.Polygon
 Set Line = recs.Fields("Shape").Value
 Dim xOld As Double
 Dim yOld As Double
 Dim xold1 As Double
 Dim yold1 As Double
 
 xold1 = 0
 yold1 = 0
 yOld = popAndPushDouble(yold1)
 xOld = popAndPushDouble(xold1)
 popEnd
 Dim lineNew As New MapObjects2.Polygon
 CopyLineAddPoint lineNew, Line, m_selPart, m_selVertex, xOld, yOld
 Set recs.Fields("Shape").Value = lineNew
 Set lineNew = Nothing
 
 recs.Update
 recs.StopEditing
 Refresh map
exit1:

End Function


Private Function UUMoveLinePoint(map As MapObjects2.map) 'undo
On Error GoTo exit1
Dim layerNum As Long, m_selLine As Long, m_selPart As Long, m_selVertex As Long
Dim x As Double, Y As Double
Dim typea As Long

 typea = popType
 m_selVertex = popInt
 m_selPart = popInt
 m_selLine = popInt
 layerNum = popInt
 Set m_map = map
 
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 recs.MoveFirst
 recs.Edit
 
 Dim i As Long
 For i = 0 To m_selLine - 1
 recs.MoveNext
 Next
 
 recs.Edit
 
 Dim Line As MapObjects2.Line
 Set Line = recs.Fields("Shape").Value
 Dim xOld As Double
 Dim yOld As Double
 Dim xold1 As Double
 Dim yold1 As Double
 
 Dim lineNewa As New MapObjects2.Line
 CopyLineMovePoint lineNewa, Line, m_selPart, m_selVertex, x, Y, xold1, yold1
 Set lineNewa = Nothing
 yOld = popAndPushDouble(yold1)
 xOld = popAndPushDouble(xold1)
 popEnd
 Dim lineNew As New MapObjects2.Line
 CopyLineMovePoint lineNew, Line, m_selPart, m_selVertex, xOld, yOld, xold1, yold1
 Set recs.Fields("Shape").Value = lineNew
 Set lineNew = Nothing
 
 recs.Update
 'recs.StopEditing
 Refresh map
exit1:
End Function

Private Function UUMovePolygonPoint(map As MapObjects2.map) 'undo
On Error GoTo exit1
Dim layerNum As Long, m_selLine As Long, m_selPart As Long, m_selVertex As Long
Dim x As Double, Y As Double
Dim typea As Long

 typea = popType
 m_selVertex = popInt
 m_selPart = popInt
 m_selLine = popInt
 layerNum = popInt
 Set m_map = map
 
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 recs.MoveFirst
 recs.Edit
 
 Dim i As Long
 For i = 0 To m_selLine - 1
 recs.MoveNext
 Next
 
 recs.Edit
 
 Dim Line As MapObjects2.Polygon
 Set Line = recs.Fields("Shape").Value
 Dim xOld As Double
 Dim yOld As Double
 Dim xold1 As Double
 Dim yold1 As Double
 
 Dim lineNewa As New MapObjects2.Polygon
 CopyLineMovePoint lineNewa, Line, m_selPart, m_selVertex, x, Y, xold1, yold1
 Set lineNewa = Nothing
 yOld = popAndPushDouble(yold1)
 xOld = popAndPushDouble(xold1)
 popEnd
 Dim lineNew As New MapObjects2.Polygon
 CopyLineMovePoint lineNew, Line, m_selPart, m_selVertex, xOld, yOld, xold1, yold1
 Set recs.Fields("Shape").Value = lineNew
 Set lineNew = Nothing
 
 recs.Update
 'recs.StopEditing
 Refresh map
exit1:
End Function

Private Function URPolygonDelPoint(map As MapObjects2.map) 'redo
On Error GoTo exit1
Dim layerNum As Long, m_selLine As Long, m_selPart As Long, m_selVertex As Long
Dim x As Double, Y As Double
Dim typea As Long

 typea = pipType
 layerNum = pipInt
 m_selLine = pipInt
 m_selPart = pipInt
 m_selVertex = pipInt
 Set m_map = map
 
 
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 recs.MoveFirst
 recs.Edit
 
 Dim i As Long
 For i = 0 To m_selLine - 1
 recs.MoveNext
 Next
 
 recs.Edit
 
 Dim Line As MapObjects2.Polygon
 Set Line = recs.Fields("Shape").Value
 Dim xOld As Double
 Dim yOld As Double
 Dim xold1 As Double
 Dim yold1 As Double
 
 Dim lineNew As New MapObjects2.Polygon
 CopyLineDelPoint lineNew, Line, m_selPart, m_selVertex, xOld, yOld
 Set recs.Fields("Shape").Value = lineNew
 Set lineNew = Nothing
 
 xOld = pipAndPushDouble(xOld)
 yOld = pipAndPushDouble(yOld)
 pipEnd
 
 recs.Update
 recs.StopEditing
 Refresh map
exit1:
End Function

Private Function URLineDelPoint(map As MapObjects2.map) 'redo
On Error GoTo exit1
Dim layerNum As Long, m_selLine As Long, m_selPart As Long, m_selVertex As Long
Dim x As Double, Y As Double
Dim typea As Long

 typea = pipType
 layerNum = pipInt
 m_selLine = pipInt
 m_selPart = pipInt
 m_selVertex = pipInt
 Set m_map = map
 
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 recs.MoveFirst
 recs.Edit
 
 Dim i As Long
 For i = 0 To m_selLine - 1
 recs.MoveNext
 Next
 
 recs.Edit
 
 Dim Line As MapObjects2.Line
 Set Line = recs.Fields("Shape").Value
 Dim xOld As Double
 Dim yOld As Double
 Dim xold1 As Double
 Dim yold1 As Double
 
 Dim lineNew As New MapObjects2.Line
 CopyLineDelPoint lineNew, Line, m_selPart, m_selVertex, xOld, yOld
 Set recs.Fields("Shape").Value = lineNew
 Set lineNew = Nothing
 
 xOld = pipAndPushDouble(xOld)
 yOld = pipAndPushDouble(yOld)
 pipEnd
 
 recs.Update
 recs.StopEditing
 Refresh map
exit1:
End Function


Private Function URMoveLinePoint(map As MapObjects2.map) 'redo
On Error GoTo exit1
Dim layerNum As Long, m_selLine As Long, m_selPart As Long, m_selVertex As Long
Dim x As Double, Y As Double
Dim typea As Long

 typea = pipType
 layerNum = pipInt
 m_selLine = pipInt
 m_selPart = pipInt
 m_selVertex = pipInt
 Set m_map = map
 
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 recs.MoveFirst
 recs.Edit
 
 Dim i As Long
 For i = 0 To m_selLine - 1
 recs.MoveNext
 Next
 
 recs.Edit
 
 Dim Line As MapObjects2.Line
 Set Line = recs.Fields("Shape").Value
 Dim xOld As Double
 Dim yOld As Double
 Dim xold1 As Double
 Dim yold1 As Double
 
 Dim lineNewa As New MapObjects2.Line
 CopyLineMovePoint lineNewa, Line, m_selPart, m_selVertex, x, Y, xold1, yold1
 Set lineNewa = Nothing
 xOld = pipAndPushDouble(xold1)
 yOld = pipAndPushDouble(yold1)
 pipEnd
 Dim lineNew As New MapObjects2.Line
 CopyLineMovePoint lineNew, Line, m_selPart, m_selVertex, xOld, yOld, xold1, yold1
 Set recs.Fields("Shape").Value = lineNew
 Set lineNew = Nothing
 
 recs.Update
 Refresh map
exit1:
End Function
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15947
  • QQ554730525
  • 铜币25339枚
  • 威望15364点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
5楼#
发布于:2003-09-22 10:25
Private Function URMovePolygonPoint(map As MapObjects2.map) 'redo
On Error GoTo exit1
Dim layerNum As Long, m_selLine As Long, m_selPart As Long, m_selVertex As Long
Dim x As Double, Y As Double
Dim typea As Long

 typea = pipType
 layerNum = pipInt
 m_selLine = pipInt
 m_selPart = pipInt
 m_selVertex = pipInt
 Set m_map = map
 
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 recs.MoveFirst
 recs.Edit
 
 Dim i As Long
 For i = 0 To m_selLine - 1
 recs.MoveNext
 Next
 
 recs.Edit
 
 Dim Line As MapObjects2.Polygon
 Set Line = recs.Fields("Shape").Value
 Dim xOld As Double
 Dim yOld As Double
 Dim xold1 As Double
 Dim yold1 As Double
 
 Dim lineNewa As New MapObjects2.Polygon
 CopyLineMovePoint lineNewa, Line, m_selPart, m_selVertex, x, Y, xold1, yold1
 Set lineNewa = Nothing
 xOld = pipAndPushDouble(xold1)
 yOld = pipAndPushDouble(yold1)
 pipEnd
 Dim lineNew As New MapObjects2.Polygon
 CopyLineMovePoint lineNew, Line, m_selPart, m_selVertex, xOld, yOld, xold1, yold1
 Set recs.Fields("Shape").Value = lineNew
 Set lineNew = Nothing
 
 recs.Update
 Refresh map
exit1:
End Function

Private Function GetUndoTypeSteps(ByVal typea As Long, iInt As Long, iDouble As Long, iObject As Long)
On Error GoTo exit1
iInt = 0
iDouble = 0
iObject = 0
'multicase
Select Case typea
Case utAddPoint
    iInt = 1
    iObject = 1
Case utAddLine
    iInt = 1
    iObject = 1
Case utMovePoint
    iInt = 2
    iDouble = 2
Case utPolygonDelPoint
    iInt = 4
    iDouble = 2
Case utLineDelPoint
    iInt = 4
    iDouble = 2
Case utMoveLinePoint
    iInt = 4
    iDouble = 2
Case utMoveLine
    iInt = 2
    iDouble = 2
Case utDelShape
    iInt = 2
Case utZoom
    iDouble = 4
Case utAddShape
    iInt = 1
    iObject = 1
Case utMovePolygon
    iInt = 2
    iDouble = 2
Case utMovePolygonPoint
    iInt = 4
    iDouble = 2
    
    Case utNone
Case Else

End Select
exit1:

End Function

Private Function URDelShape(map As MapObjects2.map) 'redo
 On Error GoTo exit1
 Dim layerNum As Long, m_selLine As Long
 Dim typea As Long
 Dim ob As Object
 
 typea = pipType
 layerNum = pipInt
 m_selLine = pipInt
 Set m_map = map
 
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 
 pipObject
 pipEnd
 
 Dim i As Long, j As Long
 j = GetRecsCount(recs)
 
 Set m_map = map
 Set recs = map.Layers(layerNum).Records
 
 Dim ai As Long
 ai = GetRecsCount(recs) - 1
 
 CalculateChangeRecs recs, m_selLine, ai
 
 recs.MoveFirst
 
 For j = 0 To ai - 1
    recs.MoveNext
 Next

 recs.Delete
 
 recs.Edit
 recs.Update
 
 recs.StopEditing
 
 CalculateSetSel -1, -1, -1
 
 Refresh map
exit1:
End Function

Private Function UUDelShape(map As MapObjects2.map) 'undo
 On Error GoTo exit1
 Dim layerNum As Long, m_selLine As Long
 Dim typea As Long
 Dim ob As Object
 
 typea = popType
 m_selLine = popInt
 layerNum = popInt
 
 Set m_map = map
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
  
 Dim count As Long
 count = GetRecsCount(recs)
 
 Set ob = popObject
 popEnd
 
 recs.AddNew
 Set recs.Fields("Shape").Value = ob
 'recs.Edit
 recs.Update
 recs.StopEditing
  
 CalculateChangeRecs recs, m_selLine, count

  recs.StopEditing
 
 CalculateSetSel -1, -1, -1
 
 Refresh map
exit1:
End Function

Private Function CalculateChangeRecs(recs As MapObjects2.Recordset, a1 As Long, a2 As Long)
On Error Resume Next
If a1 = a2 Then Exit Function
Dim i, j As Long
Dim Shape1 As Object
Dim Shape2 As Object

recs.MoveFirst
For i = 0 To a1 - 1
recs.MoveNext
Next

Set Shape1 = recs.Fields("Shape").Value

For j = 0 To a2 - a1 - 1
recs.MoveNext
Next
recs.Edit

Set Shape2 = recs.Fields("Shape").Value
Set recs.Fields("Shape").Value = Shape1
recs.Update
recs.StopEditing

recs.MoveFirst
For i = 0 To a1 - 1
recs.MoveNext
Next
recs.Edit
Set Shape1 = Nothing
Set recs.Fields("Shape").Value = Shape2
Set Shape2 = Nothing
recs.Update
recs.StopEditing

End Function

Function UDelShape(map As MapObjects2.map, layerNum As Long, m_selLine As Long)
 On Error GoTo exit1
 Dim mymap As MapObjects2.map
 Dim mylayer As Long
 Dim myselline As Long
 Set mymap = map
 mylayer = layerNum
 myselline = m_selLine
 
 Set m_map = map
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 
 recs.MoveFirst
 'recs.Edit
 
 Dim i As Long
 For i = 0 To m_selLine - 1
 recs.MoveNext
 Next
 
 pushTypeAStep utDelShape
 pushInt layerNum
 pushInt m_selLine
 Dim ob As Object
 Set ob = recs.Fields("Shape").Value
 pushObject ob
 pushEnd
 
 recs.Delete
 recs.Edit
 recs.Update
 recs.StopEditing
 Refresh map
exit1:
End Function

Private Function URMoveLine(map As MapObjects2.map) 'redo
 On Error GoTo exit1
 Dim x As Double, Y As Double
 Dim layerNum As Long, m_selLine As Long
 Dim typea As Long
 
 Dim lineNew As New MapObjects2.Line
 typea = pipType
 layerNum = pipInt
 m_selLine = pipInt
 x = pipDouble
 Y = pipDouble
 pipEnd
 
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 recs.MoveFirst
 recs.Edit
 
 Dim i As Long
 For i = 0 To m_selLine - 1
 recs.MoveNext
 Next
 
 recs.Edit
 
 Dim Line As MapObjects2.Line
 Set Line = recs.Fields("Shape").Value
 CopyLinePan lineNew, Line, x, Y
 Set recs.Fields("Shape").Value = lineNew
 Set lineNew = Nothing
 
 recs.Update
 Refresh map
exit1:
End Function

Private Function URMovePolygon(map As MapObjects2.map) 'redo
On Error GoTo exit1
 Dim x As Double, Y As Double
 Dim layerNum As Long, m_selLine As Long
 Dim typea As Long
 
 Dim lineNew As New MapObjects2.Polygon
 typea = pipType
 layerNum = pipInt
 m_selLine = pipInt
 x = pipDouble
 Y = pipDouble
 pipEnd
 
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 recs.MoveFirst
 recs.Edit
 
 Dim i As Long
 For i = 0 To m_selLine - 1
 recs.MoveNext
 Next
 
 recs.Edit
 
 Dim Line As MapObjects2.Polygon
 Set Line = recs.Fields("Shape").Value
 CopyLinePan lineNew, Line, x, Y
 Set recs.Fields("Shape").Value = lineNew
 Set lineNew = Nothing
 
 recs.Update
 Refresh map
exit1:
End Function


Private Function UUZoom(map As MapObjects2.map) 'undo

Dim typea As Long
typea = popType
Dim Rect As New MapObjects2.Rectangle
Rect.Bottom = popAndPushDouble(map.Extent.Bottom)
Rect.Top = popAndPushDouble(map.Extent.Top)
Rect.Right = popAndPushDouble(map.Extent.Right)
Rect.Left = popAndPushDouble(map.Extent.Left)
popEnd
map.Extent = Rect
Set Rect = Nothing

End Function

Private Function URZoom(map As MapObjects2.map) 'redo

Dim typea As Long
typea = pipType
Dim Rect As New MapObjects2.Rectangle
Rect.Left = pipAndPushDouble(map.Extent.Left)
Rect.Right = pipAndPushDouble(map.Extent.Right)
Rect.Top = pipAndPushDouble(map.Extent.Top)
Rect.Bottom = pipAndPushDouble(map.Extent.Bottom)
pipEnd
map.Extent = Rect
Set Rect = Nothing
End Function

Private Function UUMoveLine(map As MapObjects2.map) 'undo
 On Error GoTo exit1
 Dim x As Double, Y As Double
 Dim layerNum As Long, m_selLine As Long
 Dim typea As Long
 
 Dim lineNew As New MapObjects2.Line
 typea = popType
 m_selLine = popInt
 layerNum = popInt
 Y = popDouble
 x = popDouble
 x = -x
 Y = -Y
 popEnd
 
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 recs.MoveFirst
 recs.Edit
 
 Dim i As Long
 For i = 0 To m_selLine - 1
 recs.MoveNext
 Next
 
 recs.Edit
 
 Dim Line As MapObjects2.Line
 Set Line = recs.Fields("Shape").Value
 CopyLinePan lineNew, Line, x, Y
 Set recs.Fields("Shape").Value = lineNew
 Set lineNew = Nothing
 
 recs.Update
 Refresh map
exit1:
End Function

Private Function UUMoveLine1(map As MapObjects2.map) 'undo
 On Error GoTo exit1
 Dim x As Double, Y As Double
 Dim layerNum As Long, m_selLine As Long
 Dim typea As Long
 
 Dim lineNew As New MapObjects2.Polygon
 typea = popType
 m_selLine = popInt
 layerNum = popInt
 Y = popDouble
 x = popDouble
 x = -x
 Y = -Y
 popEnd
 
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 recs.MoveFirst
 recs.Edit
 
 Dim i As Long
 For i = 0 To m_selLine - 1
 recs.MoveNext
 Next
 
 recs.Edit
 
 Dim Line As Object
 Set Line = recs.Fields("Shape").Value
 CopyLinePan lineNew, Line, x, Y
 Set recs.Fields("Shape").Value = lineNew
 Set lineNew = Nothing
 
 recs.Update
 Refresh map
exit1:
End Function
举报 回复(0) 喜欢(0)     评分
sulin
路人甲
路人甲
  • 注册日期2003-07-28
  • 发帖数158
  • QQ
  • 铜币501枚
  • 威望0点
  • 贡献值0点
  • 银元0个
6楼#
发布于:2003-09-22 15:55
有劳斑竹了!非常感谢!
能不能用一动态数列保存这些对象,在此基础上进行UNDO和REDO如何?我看MO的VC例子ADDSHAPE就用里数列。
有这么好的斑竹,大家可要努力啊!加油!
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15947
  • QQ554730525
  • 铜币25339枚
  • 威望15364点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
7楼#
发布于:2003-09-22 17:35
当地图上数据非常大的时候,用数列可能就不太行了,当然程序就是要实验啦,支持你继续做下去,别忘记共享哦!
举报 回复(0) 喜欢(0)     评分
wangjunjolly
路人甲
路人甲
  • 注册日期2003-09-11
  • 发帖数356
  • QQ
  • 铜币1040枚
  • 威望0点
  • 贡献值0点
  • 银元0个
8楼#
发布于:2003-09-22 21:26
谢谢斑竹。。我正在看代码!!
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15947
  • QQ554730525
  • 铜币25339枚
  • 威望15364点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
9楼#
发布于:2003-09-25 14:19
hoho,只是代码的一部分,大家发挥下想象,多说点感想,
举报 回复(0) 喜欢(0)     评分
上一页
游客

返回顶部