to menxin:
我的目的是模仿Geomedia中的toolbar里的add Thematic Lengend Entry功能(就是按字段值
的范围显示不同的颜色),我参照的就是下面的例程(在help中搜索RangeLengendEntry可找
到),问题出在后面有一排问号的那行:
This example creates and displays a range legend entry in a Map View.
The entry displays annual snow fall for the United States in 5 ranges.
The example uses a customized color scheme, fonts, and enrty and
individual range characteristics. The example also uses a transformation
pipe to display the data in the Map View's cooridnate system.
Note: Change the database location to the correct directory on your machine.
TypeLibraries/OCXs required:
- Intergraph GeoMedia Client Support (PClient.tlb)
- Intergraph GeoMedia Database Pipes (PDBPipe.tlb)
- Intergraph GeoMedia Coordinate Systems (PCSS.tlb)
- Intergraph Geomedia Thematic Display (PAdvLgd.tlb)
- Intergraph GeoMedia Map Viewing (PView.tlb)
- Intergraph GeoMedia Map View Control (mapview.ocx).
Form controls: A GMMapView control (
GMMapView1).
Option Explicit
Dim objRLE As RangeLegendEntry, objConn As New Connection
Dim objOPipe As OriginatingPipe, objXformPipe As CSSTransformPipe
Private Sub Form_Load()
' Set Map View parameters
Set GMMapView1.CoordSystemsMgr = New CoordSystemsMgr
With GMMapView1.CoordSystemsMgr.CoordSystem
.BaseStorageType = csbsProjected
.RefSpaceMgr.ProjSpace.ProjAlgorithmVal
= cspaRobinson
End With
Set GMMapView1.Legend = New Legend
' Create connection and store spatial filter with connection
With objConn
.Location = "D:/Warehouses/USSampleData.mdb"
.Description = "US Sample Data"
.Mode = gmcModeReadOnly
.Type = "Access.GDatabase"
.ConnectionName = "Connect1"
Set .CoordSystemsMgr = GMMapView1.CoordSystemsMgr
.Connect
End With
' Create recordset of States
objConn.CreateOriginatingPipe objOPipe
objOPipe.Table = "States"
' Transform the recordset to the Map View projection
Set objXformPipe = CreateObject("Geomedia.CSSTransformPipe")
Set objXformPipe.InputRecordset = objOPipe.OutputRecordset
objXformPipe.
InputGeometryFieldName = "Geometry"
Set objXformPipe.CoordSystemsMgr = GMMapView1.CoordSystemsMgr
' Create range legend entry for states
Set objRLE = CreateObject("Geomedia.RangeLegendEntry")
' Define standard color scheme for thematic entry
Dim objColor As ColorScheme, objColors As ColorSchemes
Dim Colors(5) As Long
Set objColors = CreateObject("Geomedia.ColorSchemes")
Set objColor = CreateObject("Geomedia.ColorScheme")
Colors(0) = RGB(188, 188, 65)
Colors(1) = RGB(213, 204, 187)
Colors(2) = RGB(255, 255, 65)
Colors(3) = RGB(128, 180, 128)
Colors(4) = RGB(144, 127, 97)
With objColor
.Colors = Colors() ?????????????????
.Name = "Autumn"
.Type = gmcsStandard
End With
objColors.Append objColor
Set objRLE.ColorSchemes = objColors
objRLE.ColorSchemeIndex = objRLE.ColorSchemes.Count
Set objColors = Nothing
Set objColor = Nothing
' Set Range legend entry characteristics
With objRLE
.GeometryFieldName = "Geometry"
Set .Recordset = objXformPipe.OutputRecordset
Set .Style = New AreaStyle
.ContentsMode = gmalContentsModeDescription
.DisplayMode = gmlDisplayModeOn
.Selected = False
.StatisticsMode = gmalStatisticsModeRange
.Visible = True
.AttributeFieldName = "ANNULSNOW"
.SetRanges gmalRangeByEqualCount, 5
End With
Set objOPipe = Nothing
Set objXformPipe = Nothing
Dim objRange As Range
For Each objRange In objRLE.Ranges
objRange.Description = objRange.
RangeMinimum & " to " _
& objRange.RangeMaximum & " inches"
objRange.Include = True
Next
Set objRange = Nothing
' Set title font
Dim objFont As Font
Set objFont = CreateObject("StdFont")
With objFont
.Name = "Arial"
.Size = 10
.Bold = True
End With
Set objRLE.TitleFont = objFont
objRLE.TitleFontColor = RGB(0, 0, 100)
objRLE.Title = "States by Annual Snow Fall"
Set objFont = Nothing
' Set subtitle font
Set objFont = CreateObject("StdFont")
With objFont
.Name = "Arial"
.Size = 8
.Italic = True
End With
Set objRLE.SubtitleFont = objFont
objRLE.SubtitleFontColor = RGB(0, 0, 200)
Dim dblMin As Double, dblMax As Double
objRLE.GetDisplayScaleRange dblMin, dblMax
objRLE.Subtitle = "Display Scale Range = " & dblMin & " to " & dblMax
Set objFont = Nothing
' Set range heading font
Set objFont = CreateObject("StdFont")
With objFont
.Name = "Arial"
.Size = 8
End With
Set objRLE.HeadingFont = objFont
objRLE.HeadingFontColor = RGB(0, 100, 100)
Set objFont = Nothing
' Append legend entry to Map View legend
If objRLE.ValidateSource Then
GMMapView1.Legend.LegendEntries.Append
objRLE
objRLE.LoadData
End If
GMMapView1.Legend.Fit
GMMapView1.Legend.Visible = True
GMMapView1.Fit
Set objRLE = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set objConn = Nothing
End Sub