📄 frmsymbolshow.frm
字号:
' 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 + -