dengminjie
路人甲
路人甲
  • 注册日期2006-06-03
  • 发帖数14
  • QQ
  • 铜币172枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:860回复:0

交差异或

楼主#
更多 发布于:2006-07-06 08:26
<P>Option Explicit<BR>Dim dc As New DataConnection<BR>Dim rect As New MapObjects2.Rectangle  '记录鼠标拖动的目标矩形<BR>Dim obj As Object '记录鼠标点击的图形对象<BR>Dim resultshape As Object  '记录运算结果<BR>Dim lyr As New MapObjects2.MapLayer<BR>Dim tolerent As Double '查找范围容差<BR>Dim recs As New MapObjects2.Recordset '目标图形对象的记录集</P>
<P>Private Sub CmdClear_Click() '删除所有图层<BR>   Map1.TrackingLayer.ClearEvents<BR>   While List1.ListCount > 0<BR>       List1.RemoveItem List1.ListCount - 1<BR>   Wend<BR>   Set obj = Nothing<BR>   Set rect = Nothing<BR>   Set resultshape = Nothing<BR>End Sub</P>
<P><BR>Private Sub Cmddelet_Click() '单个图层删除<BR>  If Not List1.ListIndex Then<BR>        If Not List1.ListCount = 0 Then<BR>            Map1.TrackingLayer.RemoveEvent List1.ListIndex<BR>            List1.RemoveItem List1.ListIndex<BR>        End If<BR>    Else<BR>        MsgBox "请一个选择要删除的项!"<BR>    End If<BR>End Sub</P>
<P>Private Sub CmdDraw_Click() '图形操作<BR>    On Error Resume Next<BR>       If Not obj Is Nothing And Not rect Is Nothing Then<BR>            If Option1 Then<BR>                Set resultshape = obj.Intersect(rect)<BR>            ElseIf Option2 Then<BR>               Set resultshape = obj.Union(rect)<BR>            ElseIf Option3 Then<BR>                Set resultshape = obj.Difference(rect)<BR>            ElseIf Option4 Then<BR>                Set resultshape = obj.Xor(rect)<BR>            End If<BR>            Map1.TrackingLayer.AddEvent resultshape, 1<BR>            List1.AddItem "该图形操作结果的" ; "面积为:" ; Format$(resultshape.Area * 10000, "#######.##") ; "平方公里"<BR>            Set resultshape = Nothing<BR>        End If<BR>End Sub</P>
<P>Private Sub Command1_Click() '退出程序<BR>    End<BR>End Sub</P>
<P>Private Sub Command2_Click()</P>
<P>End Sub</P>
<P>Private Sub Form_Load()  '加载数据,设置属性显示方式<BR>    dc.Database = App.Path + "\..\" + "数据"<BR>    If Not dc.Connect Then<BR>        MsgBox "No data!"<BR>        End<BR>    End If<BR>    <BR>    Set lyr.GeoDataset = dc.FindGeoDataset("States")<BR>    lyr.Symbol.SymbolType = moFillSymbol<BR>    lyr.Symbol.Color = moBlue<BR>    Map1.Layers.Add lyr</P>
<P>    legend1.setMapSource Map1<BR>    legend1.LoadLegend True<BR>    Option1.Value = True<BR>    <BR>    Map1.TrackingLayer.SymbolCount = 2<BR>    With Map1.TrackingLayer.Symbol(0)<BR>        .SymbolType = moFillSymbol<BR>        .Color = moGreen<BR>        .Style = moCrossFill<BR>    End With<BR>    With Map1.TrackingLayer.Symbol(1)<BR>        .SymbolType = moFillSymbol<BR>        .Color = moRed<BR>        .Style = 0<BR>        .OutlineColor = moYellow<BR>    End With<BR>End Sub</P>

<P>Private Sub legend1_AfterSetLayerVisible(index As Integer, isVisible As Boolean)<BR>    Map1.Refresh<BR>End Sub</P>
<P>Private Sub List1_Click() '闪烁对象<BR>    Map1.FlashShape Map1.TrackingLayer.Event(List1.ListIndex).Shape, 2<BR>End Sub</P>

<P>Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) '左键选定对象,右键绘制矩形<BR>    If Button = vbLeftButton Then<BR>        Dim pt As MapObjects2.Point<BR>        Set lyr = Map1.Layers(0)<BR>        Set pt = Map1.ToMapPoint(X, Y)<BR>        tolerent = 0.2<BR>        Set recs = lyr.SearchByDistance(pt, tolerent, "")<BR>        If Not recs.EOF Then<BR>            Set obj = recs.Fields("shape").Value<BR>            Map1.FlashShape obj, 3<BR>        End If<BR>    End If<BR>    If Button = vbRightButton Then<BR>        Set rect = Map1.TrackRectangle<BR>        Map1.TrackingLayer.AddEvent rect, 0<BR>        List1.AddItem "该目标矩形的面积为:" ; Format$((rect.Top - rect.Bottom) * (rect.Right - rect.Left) * 10000, "#######.##") ; "平方公里"<BR>    End If<BR>End Sub<BR></P>
<P>请问有什么可以改进??谢谢</P>
喜欢0 评分0
游客

返回顶部