?? mod_layersql.bas
字號:
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
'點(diǎn)符號
If intShapeType = esriGeometryPoint Then
GetLayerShapeType = "Marker Symbols"
Exit Function
End If
'錯(cuò)誤
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 '指向當(dāng)前要素的光標(biāo)接口
Dim pFeaturelyr As IGeoFeatureLayer '要素圖層接口
Dim pDastStat As IDataStatistics '數(shù)據(jù)統(tǒng)計(jì)接口
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名字集合
'時(shí)間: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 '圖層字段隊(duì)列接口
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 '傳遞參數(shù)pFeatureLayer為空,則調(diào)用GetFeatureLayer函數(shù),找到要素圖層
Set pFeaturelyr = GetFeatureLayer(lyrname, m_pMap)
End If
If pFeaturelyr Is Nothing Then '找到的要素圖層為空,則退出函數(shù)
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) '若傳遞參數(shù)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 '要素選擇集合
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -