阅读:946回复:0
交差异或
<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> |
|