将自定义符号导入Style文件代码

'这个过程完成了加载的全过成
'日期:2005-09-15

Public Sub TruetypeToStyle()

    Dim pStyleGallery As IStyleGallery             

'Style文件的编辑环境
    Dim pStyleGalleryItem As IStyleGalleryItem      '符号

库中的一个符号队形
    'Dim pMarkerSymbolStyleGalleryClass As

IStyleGalleryClass
    Dim pItems As IEnumStyleGalleryItem             '一组

符号
    Dim pStylStor As IStyleGalleryStorage           '管理

编辑环境中的文件对象
    Dim pCharMarkerSym As ICharacterMarkerSymbol    '将要

添加到Style文件中的符号
    Dim pFont As IFont                    '字体
    Dim pFilePath As String                         '自定

义Style文件的路径
    Dim pTargetFile As String                       '目标

文件
   
    '将自定义Style文件添加到StyleGallery
    Set pStylStor = New StyleGallery
    Set pStyleGallery = pStylStor
    pFilePath = pStylStor.DefaultStylePath &

"CustomStyle.style"
   
    pTargetFile = pStylStor.TargetFile
    If pTargetFile = pFilePath Then
        '系统会默认一个路径
    Else
        pStylStor.TargetFile = pFilePath
        pStylStor.AddFile pFilePath
    End If
    '创建各个符号对象
    Set pFont = New SystemFont
    pFont.Name = "Cityblueprint"
    pFont.Italic = True
    Dim pCount As Long
   
    Dim pColor As IColor
    Set pColor = New RgbColor
    pColor.RGB = RGB(255, 0, 0)
   
    '要加载所有的字体中的符号需要你记下字体中的符号数目

    Dim i As Long
    i = 0
    Set pCharMarkerSym = New CharacterMarkerSymbol
    With pCharMarkerSym
        .Angle = 0
        .Font = pFont
        .CharacterIndex = i
        .Color = pColor
        .size = 20
        .XOffset = 0
        .YOffset = 0
    End With
   
   
    Do While Not pCharMarkerSym Is Nothing
       
        Set pStyleGalleryItem = New StyleGalleryItem
        With pStyleGalleryItem
            .Category = "Default"
            .Name = "Try" + CStr(i)
            .Item = pCharMarkerSym
        End With
       
        '将创建的符号添加到指定的Style文件中去
        pStyleGallery.AddItem pStyleGalleryItem
        i = i + 1
       
        If i >= 400 Then
            Exit Do
        End If
       
        pCharMarkerSym.CharacterIndex = i
    Loop
   
        '删除添加的条目
    'Set pItems = pStyleGallery.Items("Marker Symbols",

pFilePath, "Default")
    'pItems.Reset
   
    'Dim pItem As IStyleGalleryItem
    'Dim j As Long
    'j = 0
    'Set pItem = pItems.Next
    'Do While Not pItem Is Nothing
       ' pStyleGallery.RemoveItem pItem
        'Set pItem = pItems.Next
       ' j = j + 1
   ' Loop
   
    '清空内存
    'pStylStor.RemoveFile pFilePath
    Set pStyleGallery = Nothing
    Set pStyleGalleryItem = Nothing
    Set pCharMarkerSym = Nothing
    Set pItems = Nothing
    Set pFont = Nothing
    Set pStylStor = Nothing
    Set pColor = Nothing
    'Set pItem = Nothing
End Sub

'功能:把Style文件从Style管理器中移出
'日期:2005-09-15

Public Sub RemoveFileFromStyleManager()
    Dim pStyleGallery As IStyleGallery             

'Style文件的编辑环境
    Dim pStylStor As IStyleGalleryStorage           '管理

编辑环境中的文件对象
    Dim pFilePath As String                         '自定

义Style文件的路径
   
    '将自定义Style文件添加到StyleGallery
    Set pStylStor = New StyleGallery
    Set pStyleGallery = pStylStor
    pFilePath = pStylStor.DefaultStylePath &

"CustomStyle.style"
    pStylStor.RemoveFile pFilePath
   
    '清空内存
    Set pStyleGallery = Nothing
    Set pStyleGalleryItem = Nothing
    pFilePath = ""
   
End Sub

'功能:删除指定Style文件中的符号
'日期:2005-09-15

Public Sub RemoveItem()
    Dim pItems As IEnumStyleGalleryItem             '一组

符号
    Dim pStyleGallery As IStyleGallery             

'Style文件的编辑环境
    Dim pFilePath As String
    Dim pStylStor As IStyleGalleryStorage           '管理

编辑环境中的文件对象
   
    pFilePath = "D:/Program

Files/ArcGIS/Bin/Styles/CustomStyle.style"
    Set pStyleGallery = New StyleGallery
    Set pStylStor = pStyleGallery
    pStylStor.AddFile pFilePath
   
    Set pItems = pStyleGallery.Items("Marker Symbols",

pFilePath, "Default")
    pItems.Reset
   
    If pItems Is Nothing Then
        Exit Sub
    End If
   
        '删除添加的条目
    Dim pItem As IStyleGalleryItem
    Dim j As Long
    j = 0
    Set pItem = pItems.Next
    Do While Not pItem Is Nothing
        pStyleGallery.RemoveItem pItem
        Set pItem = pItems.Next
        j = j + 1
    Loop

End Sub

注释:这个这些功能的总体思路是
1、将Style文件添加到Style文件管理器
2、创建一个符号
3、将符号添加到Style文件