这个类是用于模拟IdentifyDialog，但是代码写的比较简单，就是简单显示了一下数据，数据显示使用的是MSFlexGrid控件。
Public pMap As IMap
Dim valueArr() As String
Dim FieldCount As Integer
Public Sub AddLayerIdentifyPoint(ByVal pFeatLyr As IFeatureLayer, ByVal pPoint As IPoint)
Dim pAV As IActiveView
Set pAV = pMap
Dim pFeatureLayer As IFeatureLayer
Set pFeatureLayer = pFeatLyr
Dim pFeatureClass As IFeatureClass
Set pFeatureClass = pFeatureLayer.FeatureClass
FieldCount = pFeatureClass.Fields.FieldCount
Dim pToPo As ITopologicalOperator
Set pToPo = pPoint
Dim pBufferGeo As IGeometry
Set pBufferGeo = pToPo.Buffer(ConvertPixelsToMapUnits(pMap, 4))
Dim pBufferEnv As IEnvelope
Set pBufferEnv = pBufferGeo.Envelope
Dim pSpatialFilter As ISpatialFilter
Set pSpatialFilter = New SpatialFilter
Set pSpatialFilter.Geometry = pBufferEnv
pSpatialFilter.GeometryField = pFeatureClass.ShapeFieldName
Select Case pFeatureClass.ShapeType
Case 1
pSpatialFilter.SpatialRel = esriSpatialRelContains
Case 3
pSpatialFilter.SpatialRel = esriSpatialRelCrosses
Case 4
pSpatialFilter.SpatialRel = esriSpatialRelIntersects
Case Else
End Select
Dim pFeatCursor As IFeatureCursor
Set pFeatCursor = pFeatureClass.Search(pSpatialFilte*, **lse)
Dim pFeat As IFeature
Set pFeat = pFeatCursor.NextFeature
Dim nField As Integer
Do While Not pFeat Is Nothing
For nField = 0 To FieldCount - 1
ReDim Preserve valueArr(2, nField)
valueArr(0, nField) = pFeat.Fields.Field(nField).Name
If pFeat.Fields.Field(nField).Name <> "SHAPE" Then
If pFeat.Value(nField) <> "" Then
valueArr(1, nField) = pFeat.Value(nField)
Else
valueArr(1, nField) = "<NULL>"
End If
Else
Select Case pFeatureClass.ShapeType
Case 1
valueArr(1, nField) = "Point"
Case 3
valueArr(1, nField) = "Polyline"
Case 4
valueArr(1, nField) = "Polygon"
Case Else
End Select
End If
Next
Set pFeat = pFeatCursor.NextFeature
Loop
DialogShow
End Sub
Public Sub DialogShow()
Dim pFM2 As New Form2
pFM2.MSFlexGrid1.Clear
pFM2.MSFlexGrid1.Cols = 2
pFM2.MSFlexGrid1.Rows = FieldCount
Dim i As Integer
For i = 0 To pFM2.MSFlexGrid1.Rows - 1
pFM2.MSFlexGrid1.TextMatrix(i, 0) = valueArr(0, i)
pFM2.MSFlexGrid1.TextMatrix(i, 1) = valueArr(1, i)
Next
pFM2.Show
End Sub
Private Function ConvertPixelsToMapUnits(pMap As IMap, pixelUnits As Double) As Double
Dim pActiveView As IActiveView
Set pActiveView = pMap
Dim realWorldDisplayExtent As Double
Dim pixelExtent As Integer
Dim sizeOfOnePixel As Double
pixelExtent = pActiveView.ScreenDisplay.DisplayTransformation.DeviceFrame.Right - pActiveView.ScreenDisplay.DisplayTransformation.DeviceFrame.Left
realWorldDisplayExtent = pActiveView.ScreenDisplay.DisplayTransformation.VisibleBounds.Width
sizeOfOnePixel = realWorldDisplayExtent / pixelExtent
ConvertPixelsToMapUnits = pixelUnits * sizeOfOnePixel
End Function
调用这个类也很简单：
Private Sub MapControl1_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)
Dim pid As New IdentifyDialog
Dim pPt As IPoint
Set pPt = New Point
pPt.x = mapX
pPt.y = mapY
Set pid.pMap = MapControl1.Map
pid.AddLayerIdentifyPoint MapControl1.Map.Layer(0), pPt
End Sub
（本文已被浏览 次） | | |
相关评论
