frmsymbolshow.frm

ArcEngine 这是基于AE组件的源代码

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MsFlxGrd.OCX"
Begin VB.Form frmSymbolShow 
   Caption         =   "符号显示"
   ClientHeight    =   7410
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8925
   LinkTopic       =   "Form1"
   ScaleHeight     =   7410
   ScaleWidth      =   8925
   StartUpPosition =   2  'CenterScreen
   Begin VB.PictureBox picSymbolDraw 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   2745
      Left            =   240
      ScaleHeight     =   181
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   181
      TabIndex        =   6
      Top             =   4440
      Width           =   2745
   End
   Begin VB.Frame Frame1 
      Caption         =   "详细选项"
      Height          =   3375
      Left            =   120
      TabIndex        =   3
      Top             =   840
      Width           =   6975
      Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1 
         Height          =   2895
         Left            =   2880
         TabIndex        =   5
         Top             =   360
         Width           =   3975
         _ExtentX        =   7011
         _ExtentY        =   5106
         _Version        =   393216
         FixedCols       =   0
         FocusRect       =   0
         ScrollBars      =   2
         SelectionMode   =   1
      End
      Begin VB.ListBox List1 
         Height          =   2790
         Left            =   120
         TabIndex        =   4
         Top             =   360
         Width           =   2535
      End
   End
   Begin VB.CommandButton Command1 
      Caption         =   "选择"
      Height          =   375
      Left            =   6480
      TabIndex        =   2
      Top             =   360
      Width           =   615
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   1800
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   360
      Width           =   4455
   End
   Begin VB.Label Label1 
      Caption         =   "ServerStyle文件名："
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   360
      Width           =   1575
   End
End
Attribute VB_Name = "frmSymbolShow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''加入样式种类
    Dim pStyleGalPath As String
    pStyleGalPath = "E:\LqNew\3D Basic.ServerStyle" 'App.Path + "\Esri.serverstyle"
    Text1.Text = pStyleGalPath
    
    Dim pStyleGal As IStyleGallery
    Dim pStyleStorage As IStyleGalleryStorage
    Dim pEnumStyleGall As IEnumStyleGalleryItem
    Dim pStyleItem As IStyleGalleryItem
    
        Dim strCategory As String
        Set pStyleGal = New ServerStyleGallery
        'As using the StyleGallery coclass, I can add all Fill Symbol items to the ComboBox combo1.
        Set pStyleStorage = pStyleGal
        pStyleStorage.TargetFile = pStyleGalPath
        Dim i As Long
        For i = 0 To pStyleGal.ClassCount - 1
            List1.AddItem pStyleGal.Class(i).name
        Next i
      
      
End Sub
'Public Function GetStyleGalleryClass(pStyleGallery As IStyleGallery, _
'                                     sClassName As String) As IStyleGalleryClass
'  On Error GoTo ErrorHandler
'
'  Dim pStyleGalleryClass As IStyleGalleryClass
'  Set pStyleGalleryClass = Nothing
'  Dim ClassIndex As Long
'  For ClassIndex = 0 To pStyleGallery.ClassCount - 1
'    If StrComp(pStyleGallery.Class(ClassIndex).name, sClassName, vbTextCompare) = 0 Then
'      Set pStyleGalleryClass = pStyleGallery.Class(ClassIndex)
'      Exit For
'    End If
'  Next
'  Set GetStyleGalleryClass = pStyleGalleryClass
'
'  Exit Function
'ErrorHandler:
'  HandleError True, "GetStyleGalleryClass " & c_sModuleFileName & " " & GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 4
'End Function
'
''Return a StyleGalleryItem
'Public Function GetStyleGalleryItem(pStyleGallery As IStyleGallery, _
'                                      sStyleFile As String, _
'                                      pStyleClass As IStyleGalleryClass, _
'                                      sStyleItemName As String, _
'                                      Optional sCategory As String = "") As IStyleGalleryItem
'
'  Set GetStyleGalleryItem = Nothing
'  Dim pResultItem As IStyleGalleryItem
'  Set pResultItem = Nothing
'  Dim pEnumStyleGalleryItem As IEnumStyleGalleryItem
'  Set pEnumStyleGalleryItem = pStyleGallery.Items(pStyleClass.name, _
'                                                  sStyleFile, _
'                                                  sCategory)
'  pEnumStyleGalleryItem.Reset
'  Set pResultItem = pEnumStyleGalleryItem.Next
'  Do While Not pResultItem Is Nothing
'    If StrComp(pResultItem.name, sStyleItemName, vbTextCompare) = 0 Then
'      Set GetStyleGalleryItem = pResultItem
'      Exit Function
'    End If
'    Set pResultItem = pEnumStyleGalleryItem.Next
'  Loop
'End Function
'Sub CreateAndApplyUVRenderer()
'
'     '** Paste into VBA
'     '** Creates a UniqueValuesRenderer and applies it to first layer in the map.
'     '** Layer must have "Name" field
'
'     Dim pApp As esriArcMap.Application
'     Dim pDoc As IMxDocument
'     Set pDoc = ThisDocument
'     Dim pMap As iMap
'     Set pMap = pDoc.FocusMap
'
'     Dim pLayer As ILayer
'     Set pLayer = pMap.Layer(0)
'     Dim pFLayer As IFeatureLayer
'     Set pFLayer = pLayer
'     Dim pLyr As IGeoFeatureLayer
'     Set pLyr = pFLayer
'
'     Dim pFeatCls As IFeatureClass
'     Set pFeatCls = pFLayer.FeatureClass
'     Dim pQueryFilter As IQueryFilter
'     Set pQueryFilter = New QueryFilter 'empty supports: SELECT *
'     Dim pFeatCursor As IFeatureCursor
'     Set pFeatCursor = pFeatCls.Search(pQueryFilter, False)
'
'     '** Make the color ramp we will use for the symbols in the renderer
'     Dim rx As IRandomColorRamp
'     Set rx = New RandomColorRamp
'     rx.MinSaturation = 20
'     rx.MaxSaturation = 40
'     rx.MinValue = 85
'     rx.maxValue = 100
'     rx.StartHue = 76
'     rx.EndHue = 188
'     rx.UseSeed = True
'     rx.Seed = 43
'
'     '** Make the renderer
'     Dim pRender As IUniqueValueRenderer, n As Long
'     Set pRender = New UniqueValueRenderer
'
'     Dim symd As ISimpleFillSymbol
'     Set symd = New SimpleFillSymbol
'     symd.Style = esriSFSSolid
'     symd.Outline.Width = 0.4
'
'     '** These properties should be set prior to adding values
'     pRender.FieldCount = 1
'     pRender.Field(0) = "Name"
'     pRender.DefaultSymbol = symd
'     pRender.UseDefaultSymbol = True
'
'     Dim pFeat As iFeature
'     n = pFeatCls.FeatureCount(pQueryFilter)
'     '** Loop through the features
'     Dim i As Integer
'     i = 0