uclayersymbol.ctl

arcengine+vb开发原码

        Set m_pStyleGallery = Nothing
        Exit Function
    End If

    '判断文件中是否有我们需要的标注符号
    Dim pStyleGalleryClass As IStyleGalleryClass
    Dim strClassName As String

    For i = 0 To m_pStyleGallery.ClassCount - 1

        Set pStyleGalleryClass = m_pStyleGallery.Class(i)
        strClassName = pStyleGalleryClass.Name

        '设置相应标志
        If strClassName = "Fill Symbols" Then m_bHasFillSymbolInFile = True
        If strClassName = "Line Symbols" Then m_bHasLineSymbolInFile = True
        If strClassName = "Marker Symbols" Then m_bHasMarkerSymbolInFile = True

    Next i

    '很不辛，符号库中没有任何我们需要的标注符号(目前只需要点线面符号)
    If m_bHasFillSymbolInFile = False And m_bHasLineSymbolInFile = False And m_bHasMarkerSymbolInFile = False Then
        CatchErrors ErrorNoSymbols
        LoadSymbolsFromFiles = False
        Set m_pStyleGallery = Nothing
        Exit Function
    End If

    LoadSymbolsFromFiles = True

End Function

'更新静态显示界面
Private Sub UpdateStaticDisplaying()

    '设置符号库
    If m_bChangStyleFile = False Then

        '搜索默认符号库文件
        GetStyleFile

    Else

        Dim str As String
        str = cmbSymbolFiles.ListIndex

    End If

    '设置符号类型
    If m_enumSymbolGeometryType = esriGeometryNull Then
        SetGeoTypeComoboxOnNoGeometryType                  'm_intGeometryType属性未传入
    Else
        SetGeoTypeComoboxOnHasGeometryType                 'm_intGeometryType属性已传入
    End If

End Sub

 '更新动态显示界面
Private Sub UpdateDynamicDisplaying()

    '控件启动时，如果输入的符号参数不为空，则在预览窗口显示输入的符号
    If m_bControlStart = True Then
        
        If Not m_pInputSymbol Is Nothing Then
    
            '预览符号
            Dim bResult As Boolean
            bResult = DrawToDC(picPreview.hdc, picPreview.ScaleWidth, picPreview.ScaleHeight, m_pInputSymbol, 2)
            If bResult = False Then CatchErrors ErrorPreview
            picPreview.Refresh
            
            '设置下拉框，线形尺寸，颜色
            If TypeOf m_pInputSymbol Is IFillSymbol Then
                cmbGeometryType.ListIndex = 0
            ElseIf TypeOf m_pInputSymbol Is ILineSymbol Then
                cmbGeometryType.ListIndex = 1
            ElseIf TypeOf m_pInputSymbol Is IMarkerSymbol Then
                cmbGeometryType.ListIndex = 2
            End If
            
        End If
        
    End If
    
    '设定显示界面（根据符号（点、线、面））
    If cmbGeometryType.List(cmbGeometryType.ListIndex) = "面符号" Then
        fraPolygon.Visible = True
        fraLineAndPoint.Visible = False
        m_strShapeType = "Fill Symbols"
    End If

    If cmbGeometryType.List(cmbGeometryType.ListIndex) = "线符号" Then
        fraPolygon.Visible = False
        fraLineAndPoint.Visible = True
        m_strShapeType = "Line Symbols"
        lblSizeCaption.Caption = "线宽："
    End If

    If cmbGeometryType.List(cmbGeometryType.ListIndex) = "点符号" Then
        fraPolygon.Visible = False
        fraLineAndPoint.Visible = True
        m_strShapeType = "Marker Symbols"
        lblSizeCaption.Caption = "尺寸："
    End If
    
    '更新垂直滚动条基本属性值
    UpdateHScrollBar

   '设定符号显示(显示到列表框)
    DisplaySymbols
    
    '显示输入符号的属性
    If m_bControlStart = True Then DisplaySymbolProp
     
End Sub
        
'更新垂直滚动条
Private Sub UpdateHScrollBar()

    '设定垂直滚动条
    If m_intTotalSymbolsNum = -1 Then

        '统计符号库中该类型符号个数
        m_intTotalSymbolsNum = GetStyleItemsCount

        '个数小于 9
        If m_intTotalSymbolsNum < 10 Then

            '此标注目的：修改最大最小值后，禁止执行滚动条的Chang函数
            m_bResetHscrollBar = False
            vsbSymbol.Max = 100
            vsbSymbol.Value = 100
            vsbSymbol.Min = 100
            m_bResetHscrollBar = True
            Exit Sub

        End If

        '计算垂直滚动条最小步长
        Dim intTemp As Integer
        If m_intTotalSymbolsNum Mod 3 <> 0 Then
            intTemp = Int(m_intTotalSymbolsNum / 3) + 1
        Else
            intTemp = m_intTotalSymbolsNum / 3
        End If

        intTemp = intTemp - 3

        vsbSymbol.Max = intTemp
        vsbSymbol.SmallChange = 1
        vsbSymbol.LargeChange = 2
        vsbSymbol.Min = 0
        vsbSymbol.Value = 0
        vsbSymbol.Refresh

    End If

End Sub

'设置符号类型(m_intGeometryType属性已传入)
Private Sub SetGeoTypeComoboxOnHasGeometryType()

    '目前只有这三种选择,动态加载？？？
    If m_bChangStyleFile = False Then

        cmbGeometryType.Clear
        cmbGeometryType.AddItem "面符号"
        cmbGeometryType.AddItem "线符号"
        cmbGeometryType.AddItem "点符号"

    Else
        m_bChangStyleFile = False
    End If

    Dim i As Integer
    i = 0

    '点符号
    If m_enumSymbolGeometryType = esriGeometryPoint Then

        If m_bHasMarkerSymbolInFile = True Then

            For i = 0 To cmbGeometryType.ListCount - 1
                If cmbGeometryType.List(i) = "点符号" Then

                    '初始化“符号类型”下拉框为“点图层”
                    cmbGeometryType.ListIndex = i
                    Exit For

                End If
            Next i

        End If
        
        Debug.Assert Not i = cmbGeometryType.ListCount
        If i = cmbGeometryType.ListCount Then Exit Sub
        
'        If i = cmbGeometryType.ListCount Then
'            m_enumErrorOnLoadSymbol = ErrorNoMatchedSymbol
'            Exit Sub
'        End If

    End If

    '面符号
    If m_enumSymbolGeometryType = esriGeometryPolygon Or m_enumSymbolGeometryType = esriGeometryEnvelope Then

        If m_bHasFillSymbolInFile = True Then

            For i = 0 To cmbGeometryType.ListCount - 1
                If cmbGeometryType.List(i) = "面符号" Then

                    '初始化“图层类型”下拉框为“面图层”
                    cmbGeometryType.ListIndex = i
                    Exit For

                End If
            Next i

            Debug.Assert Not i = cmbGeometryType.ListCount
            If i = cmbGeometryType.ListCount Then Exit Sub
'            If i = cmbGeometryType.ListCount Then
'                m_enumErrorOnLoadSymbol = ErrorNoMatchedSymbol
'                Exit Sub
'            End If

        End If

    End If

    '线符号
    If m_enumSymbolGeometryType = esriGeometryPolyline Or m_enumSymbolGeometryType = esriGeometryLine Then

        If m_bHasLineSymbolInFile = True Then

            For i = 0 To cmbGeometryType.ListCount - 1
                If cmbGeometryType.List(i) = "线符号" Then

                    '初始化“图层类型”下拉框为“线图层”
                    cmbGeometryType.ListIndex = i
                    Exit For

                End If
            Next i
    
            Debug.Assert Not i = cmbGeometryType.ListCount
            If i = cmbGeometryType.ListCount Then Exit Sub
'            If i = cmbGeometryType.ListCount Then
'                m_enumErrorOnLoadSymbol = ErrorNoMatchedSymbol
'                Exit Sub
'            End If

        End If

    End If

End Sub

'设置符号类型(m_intGeometryType属性未传入)
Private Sub SetGeoTypeComoboxOnNoGeometryType()

    '目前只有这三种选择,动态加载？？？
    If m_bChangStyleFile = False Then

        cmbGeometryType.Clear
        cmbGeometryType.AddItem "面符号"
        cmbGeometryType.AddItem "线符号"
        cmbGeometryType.AddItem "点符号"

    Else
        m_bChangStyleFile = False
    End If

    Dim i As Integer
    i = 0

    '面标住符号为默认值
    If m_bHasFillSymbolInFile = True Then
        For i = 0 To cmbGeometryType.ListCount - 1
            If cmbGeometryType.List(i) = "面符号" Then

                '初始化“图层类型”下拉框为“面图层”
                cmbGeometryType.ListIndex = i
                GoTo Down

            End If
        Next i
    End If

    '线标住符号为”默认值
    If m_bHasLineSymbolInFile = True Then
        For i = 0 To cmbGeometryType.ListCount - 1
            If cmbGeometryType.List(i) = "线符号" Then

                '初始化“图层类型”下拉框为“线图层”
                cmbGeometryType.ListIndex = i
                GoTo Down

            End If
        Next i
    End If

    '点标住符号为默认值
    If m_bHasMarkerSymbolInFile = True Then
        For i = 0 To cmbGeometryType.ListCount - 1
            If UCase(cmbGeometryType.List(i)) = "点符号" Then

                '初始化“图层类型”下拉框为“点图层”
                cmbGeometryType.ListIndex = i
                GoTo Down

            End If
        Next i
    End If

Down:

End Sub


'重新选择标注类型（点标注、线标注、面标注）
Private Sub cmbGeometryType_click()

    '控件刚显示时，不执行该过程
    If m_bControlStart = True Then Exit Sub

    '初始化符号个数
    m_intTotalSymbolsNum = -1

    '复位滚动条
    UpdateHScrollBar

    '更新动态显示界面
    UpdateDynamicDisplaying

End Sub

'释放内存
Private Sub UserControl_Terminate()
    Set m_pStyleGallery = Nothing
End Sub

'滚动显示符号
Private Sub vsbSymbol_Change()

   '当重新设置滚动条
   If m_bResetHscrollBar = False Then Exit Sub

   '显示符号
   If Not m_pStyleGallery Is Nothing Then
        DisplaySymbols
        Dim i As Integer

        For i = 0 To m_intCurDisplayingSymbolsNum - 1
            picShowSymbol(i).Refresh
        Next i

   End If

End Sub

 '统计当前符号库中指定类型符号的符号个数
Private Function GetStyleItemsCount() As Integer

    Dim i As Integer
    Dim pEnumStyleGalleryItem As IEnumStyleGalleryItem
    Dim pStyleGalleryItem As IStyleGalleryItem
    Dim strStylePathName As String
    i = 0

    Dim strStyleClass As String
    strStyleClass = cmbGeometryType.List(cmbGeometryType.ListIndex)

    '确定符号类型
    Select Case strStyleClass

        Case "面符号"

            Set pEnumStyleGalleryItem = m_pStyleGallery.Items("Fill Symbols", m_pStylePath, "")

            '不能打开符号库文件
            If pEnumStyleGalleryItem Is Nothing Then
                CatchErrors ErrirCanntLoadStyleFile
                Exit Function
            End If

            Set pStyleGalleryItem = pEnumStyleGalleryItem.Next

            '符号库文件已经损坏
            If pStyleGalleryItem Is Nothing Then
                CatchErrors ErrorBadStyleFile
                Exit Function
            End If

            Do While Not pStyleGalleryItem Is Nothing
                If TypeOf pStyleGalleryItem.Item Is IFillSymbol Then
                     i = i + 1
                End If
                Set pStyleGalleryItem = pEnumStyleGalleryItem.Next
            Loop


        Case "线符号"

            Set pEnumStyleGalleryItem = m_pStyleGallery.Items("Line Symbols", m_pStylePath, "")

            '不能打开符号库文件
            If pEnumStyleGalleryItem Is Nothing Then
                CatchErrors ErrirCanntLoadStyleFile
                Exit Function
            End If

            Set pStyleGalleryItem = pEnumStyleGalleryItem.Next

            '符号库文件已经损坏
            If pStyleGalleryItem Is Nothing Then
                CatchErrors ErrorBadStyleFile
                Exit Function
            End If

            Do While Not pStyleGalleryItem Is Nothing
                If TypeOf pStyleGalleryItem.Item Is ILineSymbol Then
                     i = i + 1
                End If

                Set pStyleGalleryItem = pEnumStyleGalleryItem.Next
            Loop

        Case "点符号"

            Set pEnumStyleGalleryItem = m_pStyleGallery.Items("Marker Symbols", m_pStylePath, "")

            '不能打开符号库文件
            If pEnumStyleGalleryItem Is Nothing Then
                CatchErrors ErrirCanntLoadStyleFile
                Exit Function
            End If

            Set pStyleGalleryItem = pEnumStyleGalleryItem.Next

            '符号库文件已经损坏
            If pStyleGalleryItem Is Nothing Then
                CatchErrors ErrorBadStyleFile
                Exit Function
            End If

            Do While Not pStyleGalleryItem Is Nothing
                If TypeOf pStyleGalleryItem.Item Is IMarkerSymbol Then
                     i = i + 1
                End If
                Set pStyleGalleryItem = pEnumStyleGalleryItem.Next
            Loop

    End Select

    GetStyleItemsCount = i

End Function

'显示符号
Private Sub DisplaySymbols()

    '计算第一个可见符号索引
    CalculateLTSymbolID