【正文】 ingDim pFeature As IFeaturelID = DoSet pFeature = (lID) (3)lID = Loop Until lID = 1 39。1 is returned after last valid ID has been reached = True = False = True = FalseEnd Sub‘公共函數(shù)，實現(xiàn)根據(jù)圖層的名稱和字段值獲取該要素Public Function FindFeature(player As ILayer, strFldName As String, strFldValue As String) As IFeature Dim featLyr As IFeatureLayer Dim featCur As IFeatureCursor Dim feat As IFeature Set featLyr = player Dim featCls As IFeatureClass Dim pFliter As IQueryFilter Set pFliter = New QueryFilter 39。設置選擇的名稱 = strFldName amp。 = amp。 39。 amp。 strFldValue amp。 39。 Set featCls = Set featCur = (pFliter, True) Set feat = Set FindFeature = feat End Function39。雙擊列表框時獲取該要素的屬性信息（圖片介紹和文本信息）Private Sub List1_DblClick() Dim pRow As IRow Dim player As ILayer Dim i As Integer = True39。獲取指定圖層For i = 0 To –1Dim pFl As IFeatureLayerIf =(i).Name ThenSet pFl = (i)Set player = (i) Exit ForEnd IfNext i = False Set pRow = FindFeature(player, 名稱, ) Dim nFldCount As IntegernFldCount = 39。字段個數(shù) Dim pTable As ITable Set pTable = player Dim strName(40) As String 39。存儲屬性名 Dim strValue(40) As String 39。存儲屬性值 Dim strMessage As String 39。顯示所有信息Dim k As Integer Dim inputdata As String * 1 For i = 2 To nFldCount 1 Dim pFeature As IFeature Set pFeature = pRow Dim sName As String：Dim svalue As String ‘逐個獲取該要素的字段名稱和字段值，并分別用數(shù)組存儲 sName = (i).Name strName(i) = sName svalue = (i)strValue(i) = svalue‘判斷字段名稱是否為圖片信息，如果是，picture框加載該圖片并顯示If strName(i) = 圖片信息 Then If strValue(i) Then‘裝載圖片并顯示 = True = LoadPicture( amp。 \DATA\amp。strValue(i)) End If End If ‘判斷字段名稱是否為文本信息，如果是，text框讀取該文字并顯示 If strName(i) = 文本信息 Then If strValue(i) Then = True = Open amp。 \DATA\ amp。 strValue(i) For Input As 1 Do While Not EOF(1) inputdata = Input(1, 1) = + inputdata Loop Close 1 End If End If Next I For i=0 To nFldCount 1 strMessage = strMessage amp。 strName(i) amp。 : amp。 strValue(i) amp。 Space(5) amp。 vbCrLf Next i ‘逐個將要素字段名稱和字段值顯示在text中 = strMessageEnd Sub范圍分段專題圖代碼：Private Sub cmdclass_Click() Dim m_pGeoFeatureLayer As IGeoFeatureLayer Set m_pGeoFeatureLayer=frmmain. _() Dim pTable As ITable Dim pClassify As IClassify Dim pTableHistogram As ITableHistogram Dim pHistogram As IHistogram Dim dataFrequency As Variant Dim dataValues As Variant Dim strOutput As String Dim numDesiredClasses As Integer Set pTable = m_pGeoFeatureLayer Set pTableHistogram = New TableHistogram Set pHistogram = pTableHistogram = ‘獲取分類字段 Set = pTable dataValues, dataFrequency Select Case ‘選擇分類方法 Case 0 Set pClassify = New EqualInterval Case 1 Set pClassify = New Quantile End Select dataValues, dataFrequency Dim Classes() As Double Dim ClassesCount As Long numDesiredClasses = Val(numDesiredClasses) Classes = ClassesCount = UBound(Classes) Dim pClassBreaksRenderer As IClassBreaksRenderer Set pClassBreaksRenderer = New ClassBreaksRenderer = = ClassesCount = True Dim pFromColor As IHsvColor‘產(chǎn)生初始和終止顏色確定好的一系列 Set pFromColor = New HsvColor‘渲染顏色，顏色個數(shù)由分類數(shù)確定 = Dim pToColor As IHsvColor Set pToColor = New HsvColor = Dim pRamp As IAlgorithmicColorRamp Dim pEnumColors As IEnumColors Dim ok As Boolean Set pRamp = New AlgorithmicColorRamp = esriHSVAlgorithm = pFromColor = pToColor = ClassesCount True Set pEnumColors = Dim pColor As IColor Dim pFillSymbol As ISimpleFillSymbol Dim breakIndex As Long For breakIndex = 0 To ClassesCount 1 Set pColor = Set pFillSymbol = New SimpleFillSymbol = pColor = esriSFSSolid (breakIndex) = pFillSymbol (breakIndex) =Classes(breakIndex + 1) strOutput = strOutput amp。 amp。 Classes(breakIndex + 1) amp。 vbNewLineNext breakIndex Set = pClassBreaksRenderer esriViewGeography = 范圍分段專題地圖 amp。 vbCrLf amp。 vbCrLf amp。 _ 是由 amp。 amp。 圖層中的 amp。 amp。 字段根據(jù)其值不同按照 amp。 amp。 方法渲染而成. amp。 vbCrLf amp。 _ 起始顏色值為： amp。 amp。 vbNewLine amp。 vbNewLine amp。 _ 終止顏色值為： amp。 amp。 vbNewLine amp。 vbNewLine amp。 _ 分類個數(shù)： amp。 amp。 vbNewLine amp。vbNewLineamp。_分類段分別是amp。vbNewLineamp。_ strOutput Unload frmthemeclass = True = False = False = True = False = TrueEnd Sub第 43 頁 共 48 頁