⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmsymbolshow.frm

📁 AO的开发平台
💻 FRM
📖 第 1 页 / 共 2 页
字号:
'     Dim ValFound As Boolean
'     Dim NoValFound As Boolean
'     Dim uh As Integer
'     Dim pFields As IFields
'     Dim iField As Integer
'     Set pFields = pFeatCursor.Fields
'     iField = pFields.FindField("Name")
'     Do Until i = n
'         Dim symx As ISimpleFillSymbol
'         Set symx = New SimpleFillSymbol
'         symx.Style = esriSFSSolid
'         symx.Outline.Width = 0.4
'         Set pFeat = pFeatCursor.NextFeature
'         Dim x As String
'         x = pFeat.Value(iField) '*new Cory*
'         '** Test to see if we've already added this value
'         '** to the renderer, if not, then add it.
'         ValFound = False
'         For uh = 0 To (pRender.ValueCount - 1)
'           If pRender.Value(uh) = x Then
'             NoValFound = True
'             Exit For
'           End If
'         Next uh
'         If Not ValFound Then
'             pRender.AddValue x, "Name", symx
'             pRender.Label(x) = x
'             pRender.Symbol(x) = symx
'         End If
'         i = i + 1
'     Loop
'
'     '** now that we know how many unique values there are
'     '** we can size the color ramp and assign the colors.
'     rx.Size = pRender.ValueCount
'     rx.CreateRamp (True)
'     Dim RColors As IEnumColors, ny As Long
'     Set RColors = rx.Colors
'     RColors.Reset
'     For ny = 0 To (pRender.ValueCount - 1)
'         Dim xv As String
'         xv = pRender.Value(ny)
'         If xv <> "" Then
'             Dim jsy As ISimpleFillSymbol
'             Set jsy = pRender.Symbol(xv)
'             jsy.color = RColors.Next
'             pRender.Symbol(xv) = jsy
'         End If
'     Next ny
'
'     '** If you didn't use a color ramp that was predefined
'     '** in a style, you need to use "Custom" here, otherwise
'     '** use the name of the color ramp you chose.
'     pRender.ColorScheme = "Custom"
'     pRender.FieldType(0) = True
'     Set pLyr.Renderer = pRender
'     pLyr.DisplayField = "Name"
'
'     '** This makes the layer properties symbology tab show
'     '** show the correct interface.
'     Dim hx As IRendererPropertyPage
'     Set hx = New UniqueValuePropertyPage
'     pLyr.RendererPropertyPageClassID = hx.ClassID
'
'     '** Refresh the TOC
'     pDoc.ActiveView.ContentsChanged
'     pDoc.UpdateContents
'
'     '** Draw the map
'     pDoc.ActiveView.refresh
'
'End Sub

Private Sub List1_DblClick()
    
    Dim pStyleGal As IStyleGallery
    Dim pStyleStorage As IStyleGalleryStorage
    Dim pEnumStyleGall As IEnumStyleGalleryItem
    Dim pStyleItem As IStyleGalleryItem
    MSFlexGrid1.Clear
    MSFlexGrid1.Rows = 2
    MSFlexGrid1.TextMatrix(0, 0) = "名称"
    MSFlexGrid1.TextMatrix(0, 1) = "种类"
    MSFlexGrid1.ColWidth(0) = 1995
    MSFlexGrid1.ColWidth(1) = MSFlexGrid1.Width - MSFlexGrid1.ColWidth(0) - 100
    MSFlexGrid1.ColAlignment(0) = flexAlignLeftCenter

    If List1.ListIndex <> 0 Then
        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 = Text1.Text
        strCategory = List1.Text
        Set pEnumStyleGall = pStyleGal.Items(strCategory, "", "")
       
        pEnumStyleGall.Reset
        Set pStyleItem = pEnumStyleGall.Next
        Do While Not pStyleItem Is Nothing
            'Loop through and access each marker
            'Combo1.AddItem pStyleItem.name
            MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 0) = pStyleItem.name
            MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 1) = pStyleItem.Category
            MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1
            
            Set pStyleItem = pEnumStyleGall.Next
    
            
        Loop
    End If
End Sub

Private Sub MSFlexGrid1_DblClick()

    '控制点图层的简单符号
    Dim pMarkLayer As IGeoFeatureLayer
    Dim pSimpleRenderer As ISimpleRenderer
    Dim pSimpleMarkerSymbol As ISimpleMarkerSymbol
    'Dim pSimpleMarkerSymbol As IMarkerSymbol
    Dim pRgbColor As IRgbColor
    
    Set pMarkLayer = m_pCurrentLayer
    Set pSimpleRenderer = New SimpleRenderer
    Set pSimpleMarkerSymbol = New SimpleMarkerSymbol
    ''''''''''''''''''''''''''''''''''''''''''''''''
    If List1.ListIndex <> 0 Then
        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 = Text1.Text
        strCategory = List1.Text
        Set pEnumStyleGall = pStyleGal.Items(strCategory, "", "")

        'pStyleGal.Class(0).Preview pStyleItem.Item, PictureBox.hDC, ""
        
            'Combo1.AddItem pStyleItem.name
        pEnumStyleGall.Reset
        Set pStyleItem = pEnumStyleGall.Next
        Do While Not pStyleItem Is Nothing
            'Loop through and access each marker
            'Combo1.AddItem pStyleItem.name
           ' If MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 0) = pStyleItem.name Then
                '--------------------------------------
                
               ' Set pSimpleRenderer.Symbol = pStyleItem.Item
                
                If pStyleItem.name = MSFlexGrid1.Text Then
                    Dim pSym As ISymbol
                    Set pSym = pStyleItem.Item
                    'pSym.SetupDC PictureBox.hDC, Nothing
                    'Dim pGeom As IGeometry
                    'Set pGeom.Envelope.Envelope = pSym
                     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                    Dim lResult As Boolean, lGap As Long
                    lGap = CLng(2)
                    lResult = DrawToDC(picSymbolDraw.hDC, picSymbolDraw.ScaleWidth, picSymbolDraw.ScaleHeight, pSym, lGap)
        
        
                    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                    'pSym.Draw pGeom
                    pSym.ResetDC
                
                    'psym.setupdc(getdc(piclegend.handle.toint32), nothing)
                    'pSym.Draw (pgeo)
                    'psym.resetdc()
                    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '                If TypeOf pSimpleRenderer.Symbol Is ICharacterMarkerSymbol Then
    '                    MsgBox "ICharacterMarkerSymbol"
    '                ElseIf TypeOf pSimpleRenderer.Symbol Is ISimpleMarkerSymbol Then
    '                    MsgBox "ISimpleMarkerSymbol"
    '                    Set pMarkLayer.Renderer = pSimpleRenderer
    '                     GoTo ExitLOOP
    '                ElseIf TypeOf pSimpleRenderer.Symbol Is IArrowMarkerSymbol Then
    '                    MsgBox "IArrowMarkerSymbol"
    '                ElseIf TypeOf pSimpleRenderer.Symbol Is IPictureMarkerSymbol Then
    '                    MsgBox "IPictureMarkerSymbol"
    '
    '                ElseIf TypeOf pSimpleRenderer.Symbol Is IMultiLayerMarkerSymbol Then
    '                    'MsgBox "IMultiLayerMarkerSymbol"
    '                    'Set pMLMS = pSimpleRenderer.Symbol
    '                End If
                    '--------------------------------------
                '   Set pSimpleMarkerSymbol = dd
            ' Dim dd As New marker
                'GoTo ExitLOOP
                'End If
                GoTo ExitLOOP
            End If
            Set pStyleItem = pEnumStyleGall.Next
        Loop
    End If
ExitLOOP:
    '''''''''''''''''''''''''''''''''''''''''''''''
    frmMDIMap.MapControl.refresh
    
    Set pRgbColor = Nothing
    Set pSimpleMarkerSymbol = Nothing
    Set pSimpleRenderer = Nothing
    Set pMarkLayer = Nothing

End Sub


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -