landserver
路人甲
路人甲
  • 注册日期2004-11-25
  • 发帖数6
  • QQ
  • 铜币139枚
  • 威望0点
  • 贡献值0点
  • 银元0个
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>
举报 回复(0) 喜欢(0)     评分
luxinglangx
路人甲
路人甲
  • 注册日期2004-05-31
  • 发帖数4
  • QQ
  • 铜币127枚
  • 威望0点
  • 贡献值0点
  • 银元0个
11楼#
发布于:2005-12-03 20:18
请教<FONT face=Verdana color=#61b713><STRONG>suppergg,</STRONG><FONT color=#000000>serverstyle具体该如何读取,现在我要实现符号化的功能,不知道该用哪些接口。</FONT></FONT>
举报 回复(0) 喜欢(0)     评分
gzstyxb
路人甲
路人甲
  • 注册日期2004-09-22
  • 发帖数358
  • QQ
  • 铜币1045枚
  • 威望0点
  • 贡献值0点
  • 银元0个
12楼#
发布于:2005-12-06 09:58
我认为,ArcMap的Symbol Selector也是一个COM组件。当然也可以在任何地方调用。当然,系统仅仅安装了Engine,就没有办法调用了。
由爱故生忧, 由爱故生怖. 若离于爱者, 无忧亦无怖.
举报 回复(0) 喜欢(0)     评分
wxy_whu
路人甲
路人甲
  • 注册日期2004-08-22
  • 发帖数36
  • QQ
  • 铜币239枚
  • 威望0点
  • 贡献值0点
  • 银元0个
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>
举报 回复(0) 喜欢(0)     评分
gzstyxb
路人甲
路人甲
  • 注册日期2004-09-22
  • 发帖数358
  • QQ
  • 铜币1045枚
  • 威望0点
  • 贡献值0点
  • 银元0个
14楼#
发布于:2005-12-12 15:49
<P>实在不行,直接调用ArcMap的symbol selector算了。</P>
由爱故生忧, 由爱故生怖. 若离于爱者, 无忧亦无怖.
举报 回复(0) 喜欢(0)     评分
上一页 下一页
游客

返回顶部