阅读:873回复:0
帮忙看一段代码,谢谢
<P>' Results of spatial search
Dim g_selectedFeatures As MapObjects2.Recordset</P> <P>' Search shapes when using other features to search. Dim g_searchSet As MapObjects2.Recordset</P> <P>' Search shape when using rubberbanded shape to search Dim g_searchShape As Object</P> <P>Dim g_selectedBounds As MapObjects2.Rectangle Dim g_searchBounds As MapObjects2.Rectangle Private Sub Command1_Click() Dim dc As New DataConnection Dim gs As GeoDataset Dim name As String Dim layer As MapObjects2.MapLayer CommonDialog1.Filter = "ESRI Shapefiles(*.shp)|*.shp" CommonDialog1.ShowOpen If Len(CommonDialog1.FileName) = 0 Then Exit Sub dc.Database = CurDir If Not dc.Connect Then Exit Sub name = Left(CommonDialog1.FileTitle, Len(CommonDialog1.FileTitle) - 4) Set gs = dc.FindGeoDataset(name) If gs Is Nothing Then Exit Sub Set layer = New MapLayer layer.GeoDataset = gs Map1.Layers.Add layer End Sub</P> <P>Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim pt As MapObjects2.Point Set pt = Map1.ToMapPoint(X, Y) Set g_searchShape = pt Dim ptBounds As New MapObjects2.Rectangle ptBounds.Left = pt.X ptBounds.Top = pt.Y ptBounds.Right = pt.X ptBounds.Bottom = pt.Y Set g_searchBounds = ptBounds Set g_searchSet = Nothing ExecuteSearch End Sub Sub ExecuteSearch() ' ' We're either searching with a single shape or a ' record set. The search routines don't care so, ' put the search shape(s) in a single variable ' called shapes. ' Dim shapes As Object Set shapes = Nothing If Not g_searchShape Is Nothing Then Set shapes = g_searchShape If Not g_searchSet Is Nothing Then Set shapes = g_searchSet If shapes Is Nothing Then Exit Sub ' reset the selection and execute the search Screen.MousePointer = 11 Set g_selectedFeatures = Nothing Set g_selectedFeatures = Map1.Layers(0).SearchByDistance(shapes, 0.05, "") Set g_selectedBounds = GetRecordsetBounds(g_selectedFeatures) Map1.TrackingLayer.Refresh True Screen.MousePointer = 0 End Sub </P> <P>Private Function GetRecordsetBounds(recs As MapObjects2.Recordset) As MapObjects2.Rectangle ' Get the bounds of the recordset Set GetRecordsetBounds = Nothing If Not recs Is Nothing Then Dim bounds As MapObjects2.Rectangle Set bounds = Nothing Set fld = recs("Shape") ' For each feature in recordset... recs.MoveFirst Do While Not recs.EOF ' get shape bounds Dim shapeBounds As MapObjects2.Rectangle If fld.Type = moPoint Then Dim pt As MapObjects2.Point Set pt = fld.Value Dim ptBounds As New MapObjects2.Rectangle ptBounds.Left = pt.X ptBounds.Top = pt.Y ptBounds.Right = pt.X ptBounds.Bottom = pt.Y Set shapeBounds = ptBounds ElseIf fld.Type = moLine Then Dim l As MapObjects2.Line Set l = fld.Value Set shapeBounds = l.Extent ElseIf fld.Type = moPolygon Then Dim p As MapObjects2.Polygon Set p = fld.Value Set shapeBounds = p.Extent Else MsgBox "Invalid shape in GetRecordsetBounds!" End If ' add shape bounds to total If bounds Is Nothing Then Set bounds = shapeBounds Else bounds.Union shapeBounds End If recs.MoveNext Loop Set GetRecordsetBounds = bounds End If End Function</P> <P> Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As StdOle.OLE_HANDLE) If g_searchBounds Is Nothing And g_selectedBounds Is Nothing Then Exit Sub ' Either g_searchSet or g_searchShape will be valid. DrawRecordset g_selectedFeatures, moMagenta, moSolidFill DrawRecordset g_searchSet, moYellow, moTransparentFill DrawShape g_searchShape, moYellow, moTransparentFill End Sub</P> <P> Sub DrawShape(shape As Object, color, style) ' draw the shape If Not shape Is Nothing Then Dim sym As New Symbol sym.color = color If style = moTransparentFill Then sym.OutlineColor = color sym.style = style Map1.DrawShape shape, sym End If End Sub</P> <P>Sub DrawRecordset(recs As MapObjects2.Recordset, color, style) Dim gline As Object Dim pt As New MapObjects2.Point ' draw the features of a RecordSet If Not recs Is Nothing Then Set gline = recs("Shape").Value Set pt = gline.Parts(0).Item(0) Dim f As MapObjects2.Field Dim sym As New Symbol sym.color = color If style = moTransparentFill Then sym.OutlineColor = color sym.style = style Map1.DrawShape recs, sym List1.AddItem pt.X End If End Sub 各位高手,以上的code要实现用鼠标捕捉shapefile里的一条线,并把线的端点的坐标在list中显示出来,现在我能捕捉线,但端点不能显示,是最后的drawrecordset函数有问题。代码比较长,哪位高手能耐心看看,不甚感激。</P><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" /> |
|