10楼#
发布于:2005-11-28 17:30
<P>个人数据库连接</P>
<P> <BR> Dim pUniqueValueRenderer As IUniqueValueRenderer<BR> Dim pSym As IFillSymbol<BR> Dim pSymLine As ILineSymbol<BR> Dim pSymPoint As ISimpleMarkerSymbol<BR> 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<BR> <BR> 'Display Labels<BR> Dim pAnnoLayerCol As IAnnotateLayerPropertiesCollection<BR> Dim pAnnoLayerPro As IAnnotateLayerProperties<BR> Dim pAnnoEnLayerPro As ILabelEngineLayerProperties 'IAnnotateLayerProperties<BR> Dim pTextSymbol As ITextSymbol<BR> <BR> <BR> Dim pPropSet As IPropertySet<BR> Set pPropSet = New PropertySet<BR> Dim pFact As IWorkspaceFactory<BR> Dim pWorkspace As IWorkspace<BR> Dim dbfilename As String<BR> CommonDialog1.Filter = "Database (*.mdb)|*.mdb"<BR> CommonDialog1.DialogTitle = "Open Personal Database"<BR> CommonDialog1.ShowOpen<BR> dbfilename = CommonDialog1.filename<BR>'Open Databse<BR>If dbfilename <> "" Then<BR> <BR> pPropSet.SetProperty "DATABASE", dbfilename<BR> Set pFact = New AccessWorkspaceFactory<BR> Set pWorkspace = pFact.Open(pPropSet, Me.hWnd)<BR> Dim pFeatureWorkspace As IFeatureWorkspace<BR> Set pFeatureWorkspace = pWorkspace<BR> Dim pMap As IMap<BR> Dim pDataFrame As IMapFrame</P> <P> <BR> Dim p As IMapSurroundFrame<BR> <BR> <BR> Dim pDSName As IDatasetName<BR> Dim pEnumDSName As IEnumDatasetName<BR> Set pEnumDSName = pWorkspace.DatasetNames(esriDTFeatureDataset)<BR> Set pDSName = pEnumDSName.Next<BR> While Not pDSName Is Nothing<BR> 'MsgBox pDSName.Name<BR> 'Set pDSName = pEnumDSName.Next<BR> <BR> <BR> Dim pFeatureDataset As IFeatureDataset<BR> Set pFeatureDataset = pFeatureWorkspace.OpenFeatureDataset(pDSName.Name)<BR> Dim pEnumDataset As IEnumDataset<BR> <BR> Set pEnumDataset = pFeatureDataset.Subsets<BR> <BR> Dim pDataset As IDataset<BR> Dim pFeatureClass As IFeatureClass<BR> Set pDataset = pEnumDataset.Next<BR> Dim pGroupLayers As IGroupLayer<BR> Set pGroupLayers = New GroupLayer<BR> Do Until pDataset Is Nothing<BR> 'If pDataset.Type = esriDTFeatureClass Then<BR> Debug.Print pDataset.Name<BR> <BR> Set pFeatureClass = pFeatureWorkspace.OpenFeatureClass(pDataset.Name)<BR> Dim pLayer As IGeoFeatureLayer<BR> Set pLayer = New FeatureLayer<BR> Set pLayer.FeatureClass = pFeatureClass<BR> pLayer.Name = pFeatureClass.AliasName<BR> <BR> pGroupLayers.Name = pDSName.Name<BR> <BR> '----------------------<BR> Dim pFieldName As String<BR> <BR> If pLayer.Name = "ADMIN_POLY" Or pLayer.Name = "ADMIN_LINE" Then<BR> pFieldName = "name"<BR> <BR> Else<BR> pFieldName = "remark"<BR> <BR> End If<BR> <BR> Set m_pGeoFeatureLayer = pLayer<BR> <BR> 'Set Label visibale<BR> '---------------------<BR> Dim pTextColor As IRgbColor<BR> Dim myFont As IFontDisp<BR> Set myFont = New StdFont<BR> myFont.Name = "Courier New"</P> <P><BR> Set pAnnoLayerCol = m_pGeoFeatureLayer.AnnotationProperties<BR> Set pAnnoEnLayerPro = New LabelEngineLayerProperties<BR> <BR> Set pTextSymbol = New TextSymbol<BR> <BR> Set pTextColor = New RgbColor<BR> pTextColor.RGB = RGB(110, 0, 225)<BR> pTextSymbol.Color = pTextColor<BR> pTextSymbol.Size = 8<BR> pTextSymbol.Font = myFont<BR> Set pAnnoEnLayerPro.Symbol = pTextSymbol<BR> pAnnoEnLayerPro.Expression = "[name]"<BR> pAnnoEnLayerPro.IsExpressionSimple = True<BR> Set pAnnoLayerPro = pAnnoEnLayerPro<BR> pAnnoLayerCol.Clear<BR> pAnnoLayerCol.Add pAnnoLayerPro<BR> <BR> pAnnoLayerCol.QueryItem 0, pAnnoLayerPro, Nothing, Nothing<BR> If pAnnoLayerPro Is Nothing Then<BR> MsgBox ("Error!!!")<BR> <BR> End If<BR> <BR> If pLayer.Name <> "ADMIN_LINE" And pLayer.Name <> "ROAD_POLY" Then<BR> m_pGeoFeatureLayer.DisplayAnnotation = True<BR> End If<BR> <BR> <BR> '------------------------<BR> Set pUniqueValueRenderer = New UniqueValueRenderer<BR> <BR> ' QI the table from the geoFeatureLayer and get the field number of<BR> <BR> Set pTable = m_pGeoFeatureLayer<BR> fieldNumber = pTable.FindField(pFieldName)<BR> If fieldNumber = -1 Then<BR> MsgBox "Can't find field called " ; pFieldName<BR> Exit Sub<BR> End If<BR> <BR> ' Specify the fied to renderer unique values with<BR> '<BR> pUniqueValueRenderer.FieldCount = 1<BR> pUniqueValueRenderer.Field(0) = pFieldName<BR> <BR> ' Set up the Color ramp, this came from looking at ArcMaps Color Ramp<BR> ' properties for Pastels.<BR> '<BR> Dim pColorRamp As IRandomColorRamp<BR> <BR> 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<BR> <BR> ' Get a enumerator on the first row of the Layer<BR> <BR> Set pQueryFilter = New QueryFilter<BR> pQueryFilter.AddField pFieldName<BR> Set pCursor = pTable.Search(pQueryFilter, True)<BR> Set pNextRow = pCursor.NextRow<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)<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> Dim pFields As IFields<BR> Set pFields = pFeatureClass.Fields<BR> <BR> If pFields.Field(1).GeometryDef.GeometryType = esriGeometryPolygon Then<BR> <BR> Set pSym = New SimpleFillSymbol<BR> <BR> pSym.Color = pNextUniqueColor<BR> pUniqueValueRenderer.AddValue codeValue, "", pSym<BR> ElseIf pFields.Field(1).GeometryDef.GeometryType = esriGeometryPolyline Then<BR> Set pSymLine = New SimpleLineSymbol<BR> pSymLine.Color = pNextUniqueColor<BR> pUniqueValueRenderer.AddValue codeValue, "", pSymLine<BR> ElseIf pFields.Field(1).GeometryDef.GeometryType = esriGeometryPoint Then<BR> Set pSymPoint = New SimpleMarkerSymbol<BR> pSymPoint.Style = esriSMSCircle<BR> <BR> pSymPoint.Size = 5<BR> pSymPoint.Color = pNextUniqueColor<BR> pUniqueValueRenderer.AddValue codeValue, "", pSymPoint<BR> End If<BR> </P> <P> ' Advance the cursor to the next row, or end of the dataset<BR> Set pNextRow = pCursor.NextRow</P> <P> Loop<BR> <BR> ' Now set the layers renderer to the unique value renderer<BR> <BR> Set m_pGeoFeatureLayer.Renderer = pUniqueValueRenderer</P> <P><BR> '----------------------<BR> If pDataset.Name = "points" Then<BR> pLayer.MaximumScale = 2000<BR> pLayer.Selectable = False<BR> <BR> <BR> End If<BR> pLayer.ShowTips = True<BR> pGroupLayers.Add pLayer<BR> <BR> <BR> ' End If<BR> Set pDataset = pEnumDataset.Next<BR> <BR> Loop<BR> pGroupLayers.Expanded = False<BR> <BR> MapControl1.AddLayer pGroupLayers<BR> <BR> MapControl1.ActiveView.PartialRefresh esriViewGeography, pGroupLayers, Nothing<BR> Set pDSName = pEnumDSName.Next<BR> Wend<BR> MapControl1.Layer(1).Visible = False<BR> ConnectPGDBMenu.Enabled = False<BR>End If<BR>End Sub</P> |
|
11楼#
发布于:2005-12-03 20:18
请教<FONT face=Verdana color=#61b713><STRONG>suppergg,</STRONG><FONT color=#000000>serverstyle具体该如何读取,现在我要实现符号化的功能,不知道该用哪些接口。</FONT></FONT>
|
|
12楼#
发布于:2005-12-06 09:58
我认为,ArcMap的Symbol Selector也是一个COM组件。当然也可以在任何地方调用。当然,系统仅仅安装了Engine,就没有办法调用了。
|
|
|
13楼#
发布于:2005-12-12 12:53
<P>Dim m_pCurrentLayer As ILayer</P>
<P>Dim pFeatureLayer As IFeatureLayer</P> <P>Set pFeatureLayer = m_pCurrentLayer<BR> If pFeatureLayer.FeatureClass.ShapeType = esriGeometryPoint Then<BR> Set m_pSymbol = MakeNewSimpleMarkerSymbol<BR> ElseIf pFeatureLayer.FeatureClass.ShapeType = esriGeometryPolyline Then<BR> Set m_pSymbol = MakeNewSimpleLineSymbol<BR> ElseIf pFeatureLayer.FeatureClass.ShapeType = esriGeometryPolygon Then<BR> Set m_pSymbol = MakeNewSimpleFillSymbol<BR> End If<BR> Dim pSymbolSelector As ISymbolSelector<BR> Set pSymbolSelector = New SymbolSelector<BR> If pSymbolSelector.AddSymbol(m_pSymbol) Then<BR> If pSymbolSelector.SelectSymbol(Me.hWnd) Then<BR> Set m_pSymbol = pSymbolSelector.GetSymbolAt(0)<BR> End If<BR> End If</P> |
|
14楼#
发布于:2005-12-12 15:49
<P>实在不行,直接调用ArcMap的symbol selector算了。</P>
|
|
|
上一页
下一页