的确是个好贴,支持一下!顺便帮你贴上:)
'这个过程完成了加载的全过成
'日期: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文件
