雨零
路人甲
路人甲
  • 注册日期2005-09-04
  • 发帖数13
  • QQ
  • 铜币144枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:2047回复:4

寻求出图和制专题图的接口

楼主#
更多 发布于:2005-09-04 15:49
请知道出图打印和制专题图的各位大侠多多指教<img src="images/post/smile/dvbbs/em12.gif" />
喜欢0 评分0
美丽人生,美丽心情
kisssy
卧底
卧底
  • 注册日期2004-04-18
  • 发帖数235
  • QQ
  • 铜币614枚
  • 威望2点
  • 贡献值0点
  • 银元0个
1楼#
发布于:2005-09-04 22:50
<P>讲讲专题图吧。</P>
<P>1、点密度渲染<BR>Public Sub RenderDotDensity(pGeoFL As IGeoFeatureLayer, strText As String)<BR>    Dim pDotDensityRenderer As IDotDensityRenderer<BR>    Dim pDotDensityFillSymbol As IDotDensityFillSymbol<BR>    Dim pRendererFields As IRendererFields<BR>    Dim pSymbolArray As ISymbolArray</P>
<P>    Set pDotDensityRenderer = New DotDensityRenderer</P>
<P>    ' Set up the fields to draw charts of<BR>    Set pRendererFields = pDotDensityRenderer<BR>    pRendererFields.AddField strText</P>
<P>    ' Set up dot density symbol<BR>    Set pDotDensityFillSymbol = New DotDensityFillSymbol<BR>    pDotDensityFillSymbol.DotSize = 3<BR>    pDotDensityFillSymbol.Color = GetRGBColor(0, 0, 0)<BR>    pDotDensityFillSymbol.BackgroundColor = GetRGBColor(239, 228, 190) ' color of tan</P>
<P>    Dim pMarkerSymbol As ISimpleMarkerSymbol</P>
<P>    ' Put one marker type into the dot density symbol<BR>    Set pSymbolArray = pDotDensityFillSymbol<BR>    Set pMarkerSymbol = New SimpleMarkerSymbol<BR>    pMarkerSymbol.style = esriSMSCircle<BR>    pMarkerSymbol.Size = 3<BR>    pMarkerSymbol.Color = GetRGBColor(0, 0, 0) ' Black<BR>    pSymbolArray.AddSymbol pMarkerSymbol</P>
<P>    Set pDotDensityRenderer.DotDensitySymbol = pDotDensityFillSymbol</P>
<P>    ' This relates to the number of dots per polygon,<BR>    ' this value works for the US population<BR>    pDotDensityRenderer.DotValue = 1</P>
<P>    Set pGeoFL.Renderer = pDotDensityRenderer</P>
<P>End Sub</P>
<P>Public Function GetRGBColor(yourRed As Long, yourGreen As Long, _<BR>                            yourBlue As Long) As IRgbColor<BR>    Dim pRGB As IRgbColor</P>
<P>    Set pRGB = New RgbColor<BR>    With pRGB<BR>        .Red = yourRed<BR>        .Green = yourGreen<BR>        .Blue = yourBlue<BR>        .UseWindowsDithering = True<BR>    End With<BR>    Set GetRGBColor = pRGB</P>
<P>End Function</P>
<P>2、唯一值渲染</P>
<P>Public Sub RenderUniqueValue(pGeoFeatureLayer As IGeoFeatureLayer, strField As String)</P>
<P>    Dim pUniqueValueRenderer As IUniqueValueRenderer</P>
<P>    Dim pColor As IColor<BR>    Dim pNextUniqueColor As IColor<BR>    Dim pEnumRamp As IEnumColors<BR>    Dim pTable As ITable<BR>    Dim fieldNumber As Long<BR>    Dim pNextRow As IRow<BR>    Dim pNextRowBuffer As IRowBuffer<BR>    Dim pCursor As ICursor<BR>    Dim pQueryFilter As IQueryFilter<BR>    Dim codeValue As Variant</P>
<P>    ' Create a color ramp, color object and a unique value renderer to be set up<BR>    ' later on<BR>    '<BR>    Set pUniqueValueRenderer = New UniqueValueRenderer</P>
<P>    ' QI the table from the geoFeatureLayer and get the field number of<BR>    '<BR>    Set pTable = pGeoFeatureLayer<BR>    fieldNumber = pTable.FindField(strField)<BR>    If fieldNumber = -1 Then<BR>        MsgBox "无法查询所操作的域! " ; strField, vbCritical + vbOKOnly, "错误提示"<BR>        Exit Sub<BR>    End If</P>
<P>    ' Specify the fied to renderer unique values with<BR>    '<BR>    pUniqueValueRenderer.FieldCount = 1<BR>    pUniqueValueRenderer.Field(0) = strField</P>
<P>    ' Set up the Color ramp, this came from looking at ArcMaps Color Ramp<BR>    ' properties for Pastels.<BR>    '<BR>    Dim pColorRamp As IRandomColorRamp</P>
<P>    Set pColorRamp = New RandomColorRamp<BR>    pColorRamp.StartHue = 0<BR>    pColorRamp.MinValue = 99<BR>    pColorRamp.MinSaturation = 15<BR>    pColorRamp.EndHue = 360<BR>    pColorRamp.MaxValue = 100<BR>    pColorRamp.MaxSaturation = 30<BR>    pColorRamp.Size = 100<BR>    pColorRamp.CreateRamp True<BR>    Set pEnumRamp = pColorRamp.Colors<BR>    Set pNextUniqueColor = Nothing</P>
<P>    ' Get a enumerator on the first row of the Layer<BR>    '<BR>    Set pQueryFilter = New QueryFilter<BR>    pQueryFilter.AddField strField<BR>    Set pCursor = pTable.Search(pQueryFilter, True)<BR>    Set pNextRow = pCursor.NextRow</P>
<P>    ' Iterate through each row, adding values and a color to the unique value renderer<BR>    ' Note we don't bother filtering out duplicates,<BR>    ' if we add in a second value that is already there<BR>    ' the symbol changes but the value remains<BR>    '<BR>    Do While Not pNextRow Is Nothing</P>
<P>        ' QI the row buffer from the row and get the value<BR>        '<BR>        Set pNextRowBuffer = pNextRow<BR>        codeValue = pNextRowBuffer.Value(fieldNumber)</P>
<P>        ' Get a Color object from the color ramp and advance the enumerator<BR>        ' if we've run out then reset and start again<BR>        '<BR>        Set pNextUniqueColor = pEnumRamp.Next<BR>        If pNextUniqueColor Is Nothing Then<BR>            pEnumRamp.Reset<BR>            Set pNextUniqueColor = pEnumRamp.Next<BR>        End If</P>
<P>        ' Set the symbol to the Color and add it to render a given value<BR>        '<BR>        Select Case pGeoFeatureLayer.FeatureClass.ShapeType<BR>          Case esriGeometryType.esriGeometryPolygon<BR>            Dim pSym As IFillSymbol<BR>            Set pSym = New SimpleFillSymbol<BR>            pSym.Color = pNextUniqueColor<BR>            pUniqueValueRenderer.AddValue codeValue, codeValue, pSym<BR>          Case esriGeometryType.esriGeometryLine<BR>            Dim pSym1 As ILineSymbol<BR>            Set pSym1 = New SimpleLineSymbol<BR>            pSym1.Color = pNextUniqueColor<BR>            pUniqueValueRenderer.AddValue codeValue, codeValue, pSym1<BR>          Case esriGeometryType.esriGeometryPoint<BR>            Dim pSym2 As IMarkerSymbol<BR>            Set pSym2 = New SimpleMarkerSymbol<BR>            pSym2.Color = pNextUniqueColor<BR>            pUniqueValueRenderer.AddValue codeValue, codeValue, pSym2<BR>          Case Else<BR>            Exit Sub<BR>        End Select</P>
<P>        ' Advance the cursor to the next row, or end of the dataset<BR>        '<BR>        Set pNextRow = pCursor.NextRow</P>
<P>    Loop</P>
<P>    ' Now set the layers renderer to the unique value renderer<BR>    '<BR>    Set pGeoFeatureLayer.Renderer = pUniqueValueRenderer</P>
<P>End Sub<BR><BR>3、分类渲染</P>
<P>Public Sub cmdClassBreaks(pGeoFeatureLayer As IGeoFeatureLayer, strField As String)<BR>    On Error GoTo ErrorHandler<BR>    If pGeoFeatureLayer.FeatureClass.ShapeType <> esriGeometryPolygon Then<BR>        Exit Sub<BR>    End If<BR>    Dim pTable As ITable<BR>    Dim pClassify As IClassify<BR>    Dim pTableHistogram As ITableHistogram<BR>    Dim pHistogram As IHistogram<BR>    Dim dataFrequency As Variant<BR>    Dim dataValues As Variant<BR>    Dim strOutput As String<BR>    ' We're going to retrieve frequency data from the field<BR>    ' and then classify this data<BR>    '<BR>    Set pTable = pGeoFeatureLayer<BR>    Set pTableHistogram = New TableHistogram<BR>    Set pHistogram = pTableHistogram</P>
<P>    ' Get values and frequencies for the field<BR>    ' into a table histogram object<BR>    pTableHistogram.Field = strField<BR>    Set pTableHistogram.Table = pTable<BR>    pHistogram.GetHistogram dataValues, dataFrequency</P>
<P>    ' Put the values and frequencies into an Equal Interval classify object<BR>    '<BR>    Set pClassify = New EqualInterval<BR>    pClassify.SetHistogramData dataValues, dataFrequency</P>
<P>    ' Now a generate the classes<BR>    ' Note:<BR>    ' 1/ The number of classes returned may be different from requested<BR>    '    (depends on classification algorithm)<BR>    ' 2/ The classes array starts at index 0 and has datavalues starting<BR>    '    from the minumum value, going to maximum<BR>    '<BR>    Dim Classes() As Double<BR>    Dim ClassesCount As Long<BR>    Dim numDesiredClasses As Long<BR>    'pClassify.Classify numDesiredClasses<BR>    pClassify.Classify 8                'class count</P>
<P>    Classes = pClassify.ClassBreaks<BR>    ClassesCount = UBound(Classes)</P>
<P>    ' Initialise a new class breaks renderer and supply the number of<BR>    ' class breaks and the field to perform the class breaks on.<BR>    '<BR>    Dim pClassBreaksRenderer As IClassBreaksRenderer</P>
<P>    Set pClassBreaksRenderer = New ClassBreaksRenderer<BR>    pClassBreaksRenderer.Field = strField<BR>    pClassBreaksRenderer.BreakCount = ClassesCount<BR>    pClassBreaksRenderer.SortClassesAscending = True</P>
<P>    ' Use an algorithmic color ramp to generate an range of colors between<BR>   <BR>    Dim pFromColor As IColor<BR>    Set pFromColor = New RgbColor<BR>    pFromColor.RGB = RGB(gFR, gFG, gFB)   'your color<BR><BR>    Dim pToColor As IColor<BR>    Set pToColor = New RgbColor<BR>    pToColor.RGB = RGB(gLR, gLG, gLB)     'your color<BR><BR>    Dim pRamp As IAlgorithmicColorRamp<BR>    Dim pEnumColors As IEnumColors<BR>    Dim ok As Boolean</P>
<P>    Set pRamp = New AlgorithmicColorRamp<BR>    pRamp.Algorithm = esriHSVAlgorithm<BR>    pRamp.FromColor = pFromColor<BR>    pRamp.ToColor = pToColor<BR>    pRamp.Size = ClassesCount<BR>    pRamp.CreateRamp ok<BR>    Set pEnumColors = pRamp.Colors</P>
<P>    ' Iterate through each class brake, setting values and corresponding<BR>    ' fill symbols for each polygon, note we skip the minimum value (classes(0))<BR>    '<BR>    Dim pColor As IColor<BR>    Dim pFillSymbol As ISimpleFillSymbol<BR>    Dim breakIndex As Long</P>
<P>    For breakIndex = 0 To ClassesCount - 1</P>
<P>        ' Retrieve a color and set up a fill symbol,<BR>        ' put this in the symbol array corresponding to the class value<BR>        '<BR>        Set pColor = pEnumColors.Next<BR>        Set pFillSymbol = New SimpleFillSymbol<BR>        pFillSymbol.Color = pColor<BR>        pFillSymbol.style = esriSFSSolid<BR>        pClassBreaksRenderer.Symbol(breakIndex) = pFillSymbol<BR>        pClassBreaksRenderer.Break(breakIndex) = Classes(breakIndex + 1)</P>
<P>        ' Store each break value for user output<BR>        strOutput = strOutput ; "- " ; Classes(breakIndex + 1) ; vbNewLine</P>
<P>    Next breakIndex</P>
<P>    ' Assign the renderer to the layer and update the display<BR>    '<BR>    Set pGeoFeatureLayer.Renderer = pClassBreaksRenderer</P>
<P>Exit Sub</P>
<P>ErrorHandler:<BR>    MsgBox "无法分类!", vbCritical, "信息提示" '<BR>End Sub<BR></P>
<P>4、有关Raster,请参见我的插值程序那一贴,其中有一个方法:</P>
<P>UsingRasterClassifyColorRampRenderer</P>
个人专栏: https://zhuanlan.zhihu.com/c_165676639
举报 回复(0) 喜欢(0)     评分
gsl1982
路人甲
路人甲
  • 注册日期2004-05-08
  • 发帖数135
  • QQ
  • 铜币543枚
  • 威望0点
  • 贡献值0点
  • 银元0个
2楼#
发布于:2005-09-05 08:46
唯一值符号化,好像不太对。Set pCursor = pTable.Search(pQueryFilter, True)是得到所有记录,其中可能有重复的值。应该用IDataStatistics接口。不知还有没有其他方法。 <BR>
举报 回复(0) 喜欢(0)     评分
雨零
路人甲
路人甲
  • 注册日期2005-09-04
  • 发帖数13
  • QQ
  • 铜币144枚
  • 威望0点
  • 贡献值0点
  • 银元0个
3楼#
发布于:2005-09-05 21:08
没想到这么快就有回复,多谢多谢啦<img src="images/post/smile/dvbbs/em04.gif" />
美丽人生,美丽心情
举报 回复(0) 喜欢(0)     评分
cftao2008
路人甲
路人甲
  • 注册日期2005-03-09
  • 发帖数141
  • QQ
  • 铜币568枚
  • 威望0点
  • 贡献值0点
  • 银元0个
4楼#
发布于:2005-09-05 21:25
所以要学会看帮助!那里面什么大部分都能找到!
举报 回复(0) 喜欢(0)     评分
游客

返回顶部