layersymbol.frm

这个是grs源程序,mo在图象显示上很好,所以大家一定要下载

cdlgLayerProp.FontName = "MS Sans Serif"
cdlgLayerProp.FontSize = 10
cdlgLayerProp.FontBold = False
cdlgLayerProp.FontItalic = False
cdlgLayerProp.FontStrikethru = False
cdlgLayerProp.FontUnderline = False
cdlgLayerProp.color = moBlack
cmdApply.Enabled = True
cmdOK.Enabled = True


End Sub

Private Sub InitNoOverlapLabels()

Dim i As Integer
Dim scaleHeightUnit As Double

cboNOL.Clear
For i = 0 To tDesc.FieldCount - 1
  cboNOL.AddItem tDesc.FieldName(i)
Next
cboNOL.ListIndex = 0

cdlgLayerProp.FontName = "MS Sans Serif"
cdlgLayerProp.FontSize = 10
cdlgLayerProp.FontBold = False
cdlgLayerProp.FontItalic = False
cdlgLayerProp.FontStrikethru = False
cdlgLayerProp.FontUnderline = False
cdlgLayerProp.color = moBlack
cmdApply.Enabled = True
cmdOK.Enabled = True

fraNOL(0).Enabled = (lyr.shapeType <> moShapeTypePolygon)
For i = 0 To optNOL.count - 1
  optNOL(i).Enabled = (lyr.shapeType <> moShapeTypePolygon)
Next

End Sub

Public Sub InitZRenderer()

Dim i As Integer

If picZRlegend.count > 1 Then
  For i = (picZRlegend.count - 1) To 1 Step -1
    Unload picZRlegend(i)
    Unload lblZRlegend(i)
  Next
End If
picZRlegend(0).Visible = False
lblZRlegend(0).Visible = False

cmdApply.Enabled = False
cmdOK.Enabled = False

End Sub
'
'
'
'THE SIX PROCEDURES THAT FOLLOW, THAT BEGIN WITH THE WORD "LOAD..."
'ARE THOSE THAT RUN WHEN A RENDERER IS CHOSEN WHICH COINCIDES
'WITH THE ACTIVE LAYER'S CURRENT RENDERER.  THE PROPERTIES OF
'THAT RENDERER ARE LOADED INTO THE OPTION CONTROLS ON THAT
'RENDERER'S FORM.  THE USER CAN CHANGE THEM AT THAT POINT.
'  LoadSingleSymbol()
'  LoadUniqueValues()
'  LoadClassBreaks()
'  LoadStandardLabels()
'  LoadNoOverlapLabels()
'  LoadZRenderer()
'
'
'
Private Sub LoadSingleSymbol()

Dim i As Integer
Dim fnt As New StdFont

cboSSP(0).Clear
Select Case lyr.shapeType
  Case moShapeTypePoint
    'set control visibility
    cboSSP(1).Visible = True
    cboSSP(2).Visible = True
    chkSSP.Visible = False
    hsbSSP.Visible = True
    picSSP(1).Visible = False
    lblSSP(3).Visible = True
    lblSSP(4).Visible = True
    lblSSP(5).Visible = True
    lblSSP(6).Visible = False
    lblSSP(7).Visible = True
    'retrieve and display current values
    txtSSP(0).text = lyr.Symbol.Size
    lblSSP(0).Caption = "Marker Color:"
    lblSSP(2).Caption = "Size:"
    For i = 0 To 4
      cboSSP(0).AddItem strMarkerStyle(i)
    Next
    picSSP(0).BackColor = lyr.Symbol.color
    cboSSP(0).text = strMarkerStyle(lyr.Symbol.style)
    cboSSP(0).ListIndex = lyr.Symbol.style
    hsbSSP.Value = lyr.Symbol.Rotation
    lblSSP(7).Caption = lyr.Symbol.Rotation
    If lyr.Symbol.style = moTrueTypeMarker Then
      cboSSP(1).Enabled = True
      cboSSP(2).Enabled = True
      lblSSP(3).Enabled = True
      lblSSP(4).Enabled = True
      lblSSP(5).Enabled = True
      lblSSP(7).Enabled = True
      hsbSSP.Enabled = True
      For i = 0 To Screen.FontCount - 1
        cboSSP(1).AddItem Screen.Fonts(i)
      Next i
      cboSSP(1).text = lyr.Symbol.Font.Name
      For i = 0 To cboSSP(1).ListCount - 1
        If cboSSP(1).List(cboSSP(1).ListIndex) = cboSSP(1).text Then
          cboSSP(1).ListIndex = 1
          Exit For
        End If
      Next
      fnt.Name = cboSSP(1).text
      Set cboSSP(2).Font = fnt
      cboSSP(2).Clear
      For i = 0 To 255
        cboSSP(2).AddItem Chr(i)
      Next
      cboSSP(2).text = lyr.Symbol.CharacterIndex
      cboSSP(2).ListIndex = lyr.Symbol.CharacterIndex
    End If
    
   Case moShapeTypeMultipoint
    'set control visibility
    cboSSP(1).Visible = True
    cboSSP(2).Visible = True
    chkSSP.Visible = False
    hsbSSP.Visible = True
    picSSP(1).Visible = False
    lblSSP(3).Visible = True
    lblSSP(4).Visible = True
    lblSSP(5).Visible = True
    lblSSP(6).Visible = False
    lblSSP(7).Visible = True
    'retrieve and display current values
    txtSSP(0).text = lyr.Symbol.Size
    lblSSP(0).Caption = "Marker Color:"
    lblSSP(2).Caption = "Size:"
    For i = 0 To 4
      cboSSP(0).AddItem strMarkerStyle(i)
    Next
    picSSP(0).BackColor = lyr.Symbol.color
    cboSSP(0).text = strMarkerStyle(lyr.Symbol.style)
    cboSSP(0).ListIndex = lyr.Symbol.style
    hsbSSP.Value = lyr.Symbol.Rotation
    lblSSP(7).Caption = lyr.Symbol.Rotation
    If lyr.Symbol.style = moTrueTypeMarker Then
      cboSSP(1).Enabled = True
      cboSSP(2).Enabled = True
      lblSSP(3).Enabled = True
      lblSSP(4).Enabled = True
      lblSSP(5).Enabled = True
      lblSSP(7).Enabled = True
      hsbSSP.Enabled = True
      For i = 0 To Screen.FontCount - 1
        cboSSP(1).AddItem Screen.Fonts(i)
      Next i
      cboSSP(1).text = lyr.Symbol.Font.Name
      For i = 0 To cboSSP(1).ListCount - 1
        If cboSSP(1).List(cboSSP(1).ListIndex) = cboSSP(1).text Then
          cboSSP(1).ListIndex = 1
          Exit For
        End If
      Next
      fnt.Name = cboSSP(1).text
      Set cboSSP(2).Font = fnt
      cboSSP(2).Clear
      For i = 0 To 255
        cboSSP(2).AddItem Chr(i)
      Next
      cboSSP(2).text = lyr.Symbol.CharacterIndex
      cboSSP(2).ListIndex = lyr.Symbol.CharacterIndex
    End If
    
  Case moShapeTypeLine
    'set visibility
    cboSSP(1).Visible = False
    cboSSP(2).Visible = False
    chkSSP.Visible = False
    hsbSSP.Visible = False
    picSSP(1).Visible = False
    lblSSP(3).Visible = False
    lblSSP(4).Visible = False
    lblSSP(5).Visible = False
    lblSSP(6).Visible = False
    lblSSP(7).Visible = False
    'retrieve and display current values
    txtSSP(0).text = lyr.Symbol.Size
    lblSSP(0).Caption = "Line Color:"
    lblSSP(2).Caption = "Line width:"
    For i = 0 To 4
      cboSSP(0).AddItem strLineStyle(i)
    Next
    picSSP(0).BackColor = lyr.Symbol.color
    cboSSP(0).text = strLineStyle(lyr.Symbol.style)
    cboSSP(0).ListIndex = lyr.Symbol.style
  Case moShapeTypePolygon
    'set visibility
    cboSSP(1).Visible = False
    cboSSP(2).Visible = False
    chkSSP.Visible = True
    hsbSSP.Visible = False
    picSSP(1).Visible = True
    lblSSP(3).Visible = False
    lblSSP(4).Visible = False
    lblSSP(5).Visible = False
    lblSSP(6).Visible = True
    lblSSP(7).Visible = False
    'retrieve and display current values
    If lyr.Symbol.Size = 0 Then
      txtSSP(0).text = 1
     Else
      txtSSP(0).text = lyr.Symbol.Size
    End If
    lblSSP(0).Caption = "Fill Color:"
    lblSSP(2).Caption = "Outline width:"
    For i = 0 To 10
      cboSSP(0).AddItem strFillStyle(i)
    Next
    picSSP(0).BackColor = lyr.Symbol.color
    picSSP(1).BackColor = lyr.Symbol.OutlineColor
    cboSSP(0).text = strFillStyle(lyr.Symbol.style)
    cboSSP(0).ListIndex = lyr.Symbol.style
    Select Case lyr.Symbol.Outline
      Case True: chkSSP.Value = 1
      Case False: chkSSP.Value = 0
    End Select
End Select

End Sub

Private Sub LoadUniqueValues()

Dim i As Integer

Set vmr = lyr.Renderer

cboUV.Clear
cboUV.text = vmr.Field
For i = 0 To tDesc.FieldCount - 1
  cboUV.AddItem tDesc.FieldName(i)
  If tDesc.FieldName(i) = vmr.Field Then
    cboUV.ListIndex = i
  End If
Next
Select Case vmr.Symbol(0).Outline
  Case True:  chkUV.Value = 1
  Case False:  chkUV.Value = 0
End Select
chkUV.Visible = (lyr.shapeType = moShapeTypePolygon)
  
Call PopulateExistingUVlegend

End Sub

Private Sub LoadClassBreaks()

Dim i, j As Integer
Set cbr = lyr.Renderer
j = -1
cboCB(0).Clear
cboCB(0).text = cbr.Field
For i = 0 To tDesc.FieldCount - 1
  If tDesc.FieldType(i) = moDouble Or _
     tDesc.FieldType(i) = moLong Then
     j = j + 1
    cboCB(0).AddItem tDesc.FieldName(i)
    If tDesc.FieldName(i) = cbr.Field Then
      cboCB(0).ListIndex = j
    End If
  End If
Next
cboCB(1).text = cbr.BreakCount + 1
cboCB(1).ListIndex = cbr.BreakCount - 1
Select Case cbr.Symbol(0).Outline
  Case True
    chkCB.Value = 1
  Case False
    chkCB.Value = 0
End Select
picCBramp(0).BackColor = cbr.Symbol(0).color
picCBramp(1).BackColor = cbr.Symbol(cbr.BreakCount).color
chkCB.Visible = (lyr.shapeType = moShapeTypePolygon)

Call PopulateExistingCBlegend

End Sub

Private Sub LoadStandardLabels()

Dim i As Integer
Dim strFN As String
Set lr = lyr.Renderer

For i = 0 To tDesc.FieldCount - 1
  strFN = tDesc.FieldName(i)
  cboSL(0).AddItem strFN
  If lr.Field = strFN Then
    cboSL(0).ListIndex = i
  End If
  If tDesc.FieldType(i) = moLong Or _
     tDesc.FieldType(i) = moDouble Then
    cboSL(3).AddItem strFN
    If lr.XOffsetField = strFN Then
      cboSL(3).ListIndex = i
    End If
    cboSL(4).AddItem strFN
    If lr.YOffsetField = strFN Then
      cboSL(4).ListIndex = i
    End If
  End If
Next

Select Case lr.Symbol(0).HorizontalAlignment
  Case moAlignLeft
    cboSL(1).ListIndex = 0
  Case moAlignCenter
    cboSL(1).ListIndex = 1
  Case moAlignRight
    cboSL(1).ListIndex = 2
End Select

Select Case lr.Symbol(0).VerticalAlignment
  Case moAlignTop
    cboSL(2).ListIndex = 0
  Case moAlignCenter
    cboSL(2).ListIndex = 1
  Case moAlignBottom
    cboSL(2).ListIndex = 2
End Select

hsbSL.Value = lr.Symbol(0).Rotation
lblSL(7).Caption = lr.Symbol(0).Rotation

For i = 0 To 3
  chkSL(i).Value = 0
Next
If lr.DrawBackground Then
  chkSL(0).Value = 1
End If
If lr.AllowDuplicates Then
  chkSL(1).Value = 1
End If
If lr.SplinedText Then
  chkSL(2).Value = 1
End If
If lr.Flip Then
  chkSL(3).Value = 1
End If

txtSL.text = lr.Symbol(0).Font.Name
txtSL.ForeColor = lr.Symbol(0).color
cdlgLayerProp.FontName = lr.Symbol(0).Font.Name
cdlgLayerProp.FontSize = lr.Symbol(0).Font.Size
cdlgLayerProp.FontBold = lr.Symbol(0).Font.Bold
cdlgLayerProp.FontItalic = lr.Symbol(0).Font.Italic
cdlgLayerProp.FontStrikethru = lr.Symbol(0).Font.Strikethrough
cdlgLayerProp.FontUnderline = lr.Symbol(0).Font.Underline
cdlgLayerProp.color = lr.Symbol(0).color

   
End Sub

Private Sub LoadNoOverlapLabels()

Dim i As Integer
Dim scaleHeightUnit As Double
Dim strFN As String

Set lp = lyr.Renderer
colorMask = lp.MaskColor

cboNOL.Clear
For i = 0 To tDesc.FieldCount - 1
  strFN = tDesc.FieldName(i)
  cboNOL.AddItem strFN
  If lp.Field = strFN Then
    cboNOL.ListIndex = i
  End If
Next

cdlgLayerProp.FontName = lp.DefaultSymbol.Font.Name
cdlgLayerProp.FontSize = lp.DefaultSymbol.Font.Size
cdlgLayerProp.FontBold = lp.DefaultSymbol.Font.Bold
cdlgLayerProp.FontItalic = lp.DefaultSymbol.Font.Italic
cdlgLayerProp.FontStrikethru = lp.DefaultSymbol.Font.Strikethrough
cdlgLayerProp.FontUnderline = lp.DefaultSymbol.Font.Underline
colorText = lp.DefaultSymbol.color
txtNOL.text = lp.DefaultSymbol.Font.Name
txtNOL.ForeColor = colorText

optNOL(0).Value = lp.PlaceOn
optNOL(1).Value = lp.PlaceAbove
optNOL(2).Value = lp.PlaceBelow

Select Case lp.DrawBackground
  Case False: chkNOL(0).Value = 0
  Case True:  chkNOL(0).Value = 1
End Select

Select Case lp.AllowDuplicates
  Case False: chkNOL(1).Value = 0
  Case True:  chkNOL(1).Value = 1
End Select

Select Case lp.MaskLabels
  Case False: chkNOL(2).Value = 0
  Case True
    chkNOL(2).Value = 1
    picNOL.BackColor = lp.MaskColor
End Select

scaleHeightUnit = lyr.Extent.Width / 10000
hsbNOL.Value = 1000 - (lp.DefaultSymbol.Hei