mod_layersql.bas

arcengine+vb开发原码

Attribute VB_Name = "ModlayerSQL"
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Function GetLayerShapeType(pGeoFeatureLayer As IGeoFeatureLayer)
        
        Dim pFeatureClass As IFeatureClass
        Dim intShapeType As esriGeometryType
        
        If pGeoFeatureLayer Is Nothing Then Exit Function
        
        Set pFeatureClass = pGeoFeatureLayer.FeatureClass
        
        If pFeatureClass Is Nothing Then Exit Function
        
       
        intShapeType = pFeatureClass.ShapeType
        
        '面符号
        If intShapeType = esriGeometryPolygon Or intShapeType = esriGeometryEnvelope Then
           GetLayerShapeType = "Fill Symbols"
           Exit Function
        End If
           
        '线符号
        If intShapeType = esriGeometryPolyline Or intShapeType = esriGeometryLine Then
            GetLayerShapeType = "Line Symbols"
            Exit Function
        End If
        
        '点符号
        If intShapeType = esriGeometryPoint Then
            GetLayerShapeType = "Marker Symbols"
            Exit Function
        End If
        
        '错误
        GetLayerShapeType = ""

End Function

Public Function GetUniqueValue(ByVal strFldName As String, ByVal m_pMap As IMap, Optional strLyrName As String, Optional pfeaturelayer As IFeatureLayer) As IEnumVariantSimple
    
    Set GetUniqueValue = Nothing
    
    Dim pCursor As ICursor '指向当前要素的光标接口
    Dim pFeaturelyr As IGeoFeatureLayer '要素图层接口
    Dim pDastStat As IDataStatistics '数据统计接口
    
    On Error GoTo errorhandle
    Set pFeaturelyr = pfeaturelayer
    
    If pFeaturelyr Is Nothing Then Set pFeaturelyr = GetFeatureLayer(strLyrName, m_pMap)
   
    Set pCursor = pFeaturelyr.Search(Nothing, False)
    Set pDastStat = New DataStatistics
    pDastStat.Field = strFldName
    Set pDastStat.Cursor = pCursor
    Set GetUniqueValue = pDastStat.UniqueValues
    
  
    Set pFeaturelyr = Nothing
    Set pCursor = Nothing
    Set pDastStat = Nothing
    
    Exit Function
    
errorhandle:
     Set GetUniqueValue = Nothing
End Function

'得到地图中的featurelayer名字集合
'时间：2005.1.26
'源人：tjh
'更新：2005.2.18
Public Function GetMapFeatLayers(ByVal m_pMap As IMap) As Collection
    
    Set GetMapFeatLayers = Nothing
    
    Dim pColFeatureLayers As Collection '要素图层集合接口
    Dim pLayer As ILayer '图层接口
    Dim pEnumLayer As IEnumLayer '枚举图层接口

    On Error GoTo errorhandle
    
    If m_pMap.LayerCount = 0 Then Exit Function
    
    Set pColFeatureLayers = New Collection
    Set pEnumLayer = m_pMap.Layers
    Set pLayer = pEnumLayer.Next
    
    Do While Not pLayer Is Nothing
        
        If TypeOf pLayer Is IFeatureLayer Then
            
            pColFeatureLayers.Add pLayer.Name
        
        End If
        
        Set pLayer = pEnumLayer.Next
        
    Loop
    
    Set GetMapFeatLayers = pColFeatureLayers
    Set pLayer = Nothing
    Set pEnumLayer = Nothing
    Set pColFeatureLayers = Nothing
    
    Exit Function
    
errorhandle:
    Set GetMapFeatLayers = Nothing
    
    
End Function

Public Function GetMapSelectableFeatLayer(ByVal m_pMap As IMap) As Collection
    
    Set GetMapSelectableFeatLayer = Nothing
    
    Dim pColFeatureLayers As Collection '要素图层集合接口
    Dim pLayer As ILayer '图层接口
    Dim pEnumLayer As IEnumLayer '枚举图层接口
    Dim pfeaturelayer As IFeatureLayer '要素图层接口
    
    On Error GoTo errorhandle
    If m_pMap.LayerCount = 0 Then Exit Function
    
    Set pColFeatureLayers = New Collection
    Set pEnumLayer = m_pMap.Layers
    Set pLayer = pEnumLayer.Next
    
    Do While Not pLayer Is Nothing
    
       If TypeOf pLayer Is IFeatureLayer Then
            Set pfeaturelayer = pLayer
            If pfeaturelayer.Selectable = True Then
                pColFeatureLayers.Add pLayer.Name
            End If
       End If
    
        Set pLayer = pEnumLayer.Next
    
    Loop
    
    Set GetMapSelectableFeatLayer = pColFeatureLayers
    
    Set pColFeatureLayers = Nothing
    Set pLayer = Nothing
    Set pEnumLayer = Nothing
    Set pfeaturelayer = Nothing
    
    Exit Function
errorhandle:
    Set GetMapSelectableFeatLayer = Nothing
End Function

Public Function GetLayerFields(ByVal m_pMap As IMap, Optional lyrname As String, Optional pfeaturelayer As IFeatureLayer) As IArray
    
    Set GetLayerFields = Nothing
    
    Dim pAryLayerField As IArray '图层字段队列接口
    Dim pFeaturelyr As IGeoFeatureLayer
    Dim pFeatureClass As IFeatureClass '要素类接口
    Dim pFields  As IFields '字段集合接口
    Dim pField As IField '字段接口
    Dim intFieldIndex As Integer '字段索引号
    
    On Error GoTo errorhandle
    
    Set pAryLayerField = New esriSystem.Array
    Set pFeaturelyr = pfeaturelayer
    
    If pFeaturelyr Is Nothing Then '传递参数pFeatureLayer为空，则调用GetFeatureLayer函数，找到要素图层
        
        Set pFeaturelyr = GetFeatureLayer(lyrname, m_pMap)
    
    End If
    
    If pFeaturelyr Is Nothing Then '找到的要素图层为空，则退出函数
    
        Set pAryLayerField = Nothing
        
        Exit Function
    
    Else

    Set pFeatureClass = pFeaturelyr.DisplayFeatureClass

        If pFeatureClass Is Nothing Then Exit Function
        
        Set pFields = pFeatureClass.Fields
        
        For intFieldIndex = 0 To (pFields.FieldCount - 1)
        
            Set pField = pFields.Field(intFieldIndex)
            
            If UCase(pField.Name) <> "SHAPE" And UCase(pField.Name) <> "SHAPE.LEN" Then
                
                pAryLayerField.Add pField
            
            End If
        
        Next intFieldIndex
        
        Set pFeatureClass = Nothing
        Set pFields = Nothing
        Set pField = Nothing
    
    End If
    
    Set GetLayerFields = pAryLayerField
    Set pAryLayerField = Nothing
    Exit Function
    
errorhandle:
    Set GetLayerFields = Nothing
End Function

Public Function GetFeatureLayer(ByVal slayer As String, ByVal m_pMap As IMap) As IFeatureLayer
    
    Set GetFeatureLayer = Nothing
    
    Dim pLayers As IEnumLayer '枚举图层接口
    Dim pLayer As ILayer '图层接口
    
    On Error GoTo errorhandle
    
    If m_pMap.LayerCount = 0 Then Exit Function
    
    Set pLayers = m_pMap.Layers
    Set pLayer = pLayers.Next
    
    Do While Not pLayer Is Nothing
        
        If TypeOf pLayer Is IFeatureLayer And UCase(slayer) = UCase(pLayer.Name) Then '找到要素图层
            
            Set GetFeatureLayer = pLayer
            Exit Function
        
        End If
        
        Set pLayer = pLayers.Next
        
    Loop
    
    Set pLayer = Nothing
    Set pLayers = Nothing
    
    Exit Function
errorhandle:
    
    Set GetFeatureLayer = Nothing
    
End Function

Public Function GetLayer(ByVal slayer As String, ByVal m_pMap As IMap) As ILayer
    
    Set GetLayer = Nothing
    
    Dim pLayers As IEnumLayer '图层枚举变量接口
    Dim pLayer As ILayer '图层接口
 
    On Error GoTo GetLayer_Err
   
    Set pLayers = m_pMap.Layers
    Set pLayer = pLayers.Next
    
    Do While Not pLayer Is Nothing
    
        If UCase(slayer) = UCase(pLayer.Name) Then
            
            Set GetLayer = pLayer
            Exit Function
        
        End If
        
        Set pLayer = pLayers.Next
    Loop
    
    Set pLayers = Nothing
    Set pLayer = Nothing
    
    Exit Function
      
GetLayer_Err:
    Set GetLayer = Nothing
    
End Function


Public Function GetField(ByVal strFieldName As String, ByVal m_pMap As IMap, Optional slyrName As String, Optional pfeaturelayer As IFeatureLayer) As IField
    
    Set GetField = Nothing

    Dim pFeaturelyr As IGeoFeatureLayer
    Dim pFeatureClass As IFeatureClass '要素类接口
    Dim pFields As IFields '字段接口
    Dim intFind As Integer '字段索引号
    
    On Error GoTo errorhandle
    
    If pfeaturelayer Is Nothing Then Set pFeaturelyr = GetFeatureLayer(slyrName, m_pMap) '若传递参数pFeatureLayer为空，找到要素图层
    
    If Not pfeaturelayer Is Nothing Then
       
        Set pFeatureClass = pfeaturelayer.FeatureClass
        
        Set pFields = pFeatureClass.Fields
        
        intFind = pFeatureClass.FindField(strFieldName)
        
        If intFind <> -1 Then
        
            Set GetField = pFields.Field(intFind)
        
        End If
           
        Set pFeaturelyr = Nothing
        Set pFeatureClass = Nothing
        Set pFields = Nothing
        
    End If
    Exit Function

errorhandle:
    Set GetField = Nothing
    
End Function

Public Function QueryByAttribute(ByVal pfeaturelayer As IFeatureLayer, whereclause As String, operator As esriSelectionResultEnum) As IFeatureSelection
    
    Dim pFilter As IQueryFilter '过滤接口
    Dim pfeatureselection As IFeatureSelection '要素选择集合