|
#2
pengzhanggui2016-10-15 10:48
|
跪求！
跪求！如何对类模块IInfoList进行编辑，使类模块clsQueryByPolygon中的查询结果输出到Form1中的ListBox，或者能够在不需要类模块IInfoList的情况下将类模块clsQueryByPolygon的查询结果输出到Form1中的ListBox
以下是类模块clsQueryByPolygon中的代码
只有本站会员才能查看附件，请 登录
程序代码：Option Explicit
'要实现的接口
Implements ITool
Implements ICommand
Implements IInfoList
'成员的私有变量
Private m_pCursor As IPictureDisp
Private MapControl As MapControl
Private pListBox As ListBox
Private pColor As IColor
Private pFillSymbol As ISimpleFillSymbol
Private pLineSymbol As ISimpleLineSymbol
Private pMarkSymbol As ISimpleMarkerSymbol
Private pSymbol As ISymbol
Private Sub Class_Initialize()
'加载光标资源
Set m_pCursor = LoadResPicture("IDENTIFY", vbResCursor)
End Sub
Private Property Get ICommand_Bitmap() As esriSystem.OLE_HANDLE
End Property
Private Property Get ICommand_Caption() As String
End Property
Private Property Get ICommand_Category() As String
End Property
Private Property Get ICommand_Checked() As Boolean
End Property
Private Property Get ICommand_Enabled() As Boolean
End Property
Private Property Get Icommand_HelpContextID() As Long
End Property
Private Property Get ICommand_HelpFile() As String
End Property
Private Property Get ICommand_Message() As String
End Property
Private Property Get ICommand_Name() As String
End Property
Private Sub ICommand_OnClick()
End Sub
Private Sub Icommand_OnCreate(ByVal hook As Object)
'获得操作的MapControl对象
Set MapControl = hook
'创建点、线、面符号，用于高亮显示被选中的要素
Set pColor = New RgbColor
pColor.RGB = RGB(0, 0, 225)
Set pFillSymbol = New SimpleFillSymbol
With pFillSymbol
.Color = pColor
.Style = esriSFSDiagonalCross
End With
pColor.RGB = RGB(225, 0, 225)
Set pLineSymbol = New SimpleLineSymbol
With pLineSymbol
.Color = pColor
.Style = esriSLSDash
.Width = 2
End With
pColor.RGB = RGB(0, 225, 225)
Set pMarkSymbol = New SimpleMarkerSymbol
With pMarkSymbol
.Color = pColor
.Style = esriSMSCircle
.Size = 5
End With
End Sub
Private Property Get ICommand_Tooltip() As String
End Property
Private Property Set IInfoList_ListBox(RHS As ListBox)
Set pListBox = RHS
End Property
Private Property Get ITool_Cursor() As esriSystem.OLE_HANDLE
ITool_Cursor = m_pCursor
End Property
Private Function ITool_Deactivate() As Boolean
End Function
Private Function ITool_OnContextMenu(ByVal x As Long, ByVal y As Long) As Boolean
End Function
Private Sub ITool_OnDblClick()
End Sub
Private Sub ITool_OnKeyDown(ByVal keyCode As Long, ByVal shift As Long)
End Sub
Private Sub ITool_OnKeyUp(ByVal keyCode As Long, ByVal shift As Long)
End Sub
Private Sub ITool_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
'当发生MapControl的MouseDown事件时，开始查找地物并查询属性
Dim i As Integer, Count As Integer, idx As Integer
Dim pPolygon As esriGeometry.Polygon
Dim pFeature As IFeature
Dim pSpatialFilter As ISpatialFilter
Dim pFeaturelayer As IFeatureLayer
Dim pFeatureCursor As IFeatureCursor
Dim pFeatureSelection As IFeatureSelection
'创建点查询的“面”
Set pPolygon = MapControl.TrackPolygon
Set pSpatialFilter = New SpatialFilter
With pSpatialFilter = New SpatialFilter
Set .Geometry = pPolygon
.SpatialRel = esriSpatialRelIntersects
End With
pListBox.Clear
Count = MapControl.LayerCount
For i = 0 To Count - 1 '遍历所有图层进行查询
Set pFeatureCursor = MapControl.Layer(i)
pSpatialFilter.GeometryField = pFeaturelayer.FeatureClass.ShapeFieldName
Set pFeatureCursor = pFeaturelayer.Search(pSpatialFilter, False)
Set pFeature = pFeatureCursor.NextFeature
If Not pFeature Is Nothing Then
idx = pFeature.Fields.FindField("名称")
If idx < 0 Then idx = 0 '如果没有名称字段，则使用第一个字段
End If
While Not pFeature Is Nothing
pListBox.AddItem pFeature.Value(idx)
Set pFeature = pFeatureCursor.NextFeature
Wend
Set pFeatureSelection = pFeaturelayer
'定义选中要素的符号
If pFeaturelayer.FeatureClass.ShapeType = esriGeometryPoint Or pFeaturelayer.FeatureClass.ShapeType = esriGeometryMultipoint Then
Set pSymbol = pMarkSymbol
ElseIf pFeaturelayer.FeatureClass.ShapeType = esriGeometryPolygon Then
Set pSymbol = pFillSymbol
ElseIf pFeaturelayer.FeatureClass.ShapeType = esriGeometryPolyline Then
Set pSymbol = pLineSymbol
End If
pFeatureSelection.SelectFeatures pSpatialFilter, esriSelectionResultNew, False
pFeatureSelection.SetSelectionSymbol = True
Set pFeatureSelection.SelectionSymbol = pSymbol
Next
'刷新地图上的选择集
MapControl.ActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
'End 一次操作到此完成
End Sub
Private Sub ITool_OnMouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
End Sub
Private Sub ITool_OnMouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
End Sub
Private Sub ITool_Refresh(ByVal hdc As esriSystem.OLE_HANDLE)
End Sub
[此贴子已经被作者于2016-10-14 23:37编辑过]