layersymbol.frm

用于河南省主体功能区区划的一个小地理信息系统

          Exit Sub
        Else
          Call InitUniqueValues
        End If
      Next i
    End If
  Case 2
  
    If TypeOf lyrRend Is MapObjects2.ClassBreaksRenderer Then
      Call LoadClassBreaks
    Else
      Call InitClassBreaks
    End If
    
    If TypeOf lyrRend Is MapObjects2.GroupRenderer Then
      justOpened = True
      For i = 0 To lyrRend.Count - 1
        If TypeOf lyrRend.Renderer(i) Is MapObjects2.ClassBreaksRenderer Then
          Call LoadClassBreaks
          Exit Sub
        Else
          Call InitClassBreaks
        End If
      Next i
    End If
  Case 3
    If TypeOf lyrRend Is MapObjects2.LabelRenderer Then
      Call LoadStandardLabels
     Else
      Call InitStandardLabels
    End If
    
    If TypeOf lyrRend Is MapObjects2.GroupRenderer Then
      For i = 0 To lyrRend.Count - 1
        If TypeOf lyrRend.Renderer(i) Is MapObjects2.LabelRenderer Then
          Call LoadStandardLabels
          Exit Sub
        Else
          Call InitStandardLabels
        End If
      Next i
    End If
  Case 4
    If TypeOf lyrRend Is MapObjects2.LabelPlacer Then
      Call LoadNoOverlapLabels
     Else
      Call InitNoOverlapLabels
    End If
    
    If TypeOf lyrRend Is MapObjects2.GroupRenderer Then
      For i = 0 To lyrRend.Count - 1
        If TypeOf lyrRend.Renderer(i) Is MapObjects2.LabelPlacer Then
          Call LoadNoOverlapLabels
          Exit Sub
        Else
          Call InitNoOverlapLabels
        End If
      Next i
    End If
  Case 5
    If TypeOf lyrRend Is MapObjects2.GroupRenderer Then
      Call Loadgr
     Else
      Call initgr
    End If
End Select

End Sub
'
'
'
'THE SIX PROCEDURES THAT FOLLOW, THAT BEGIN WITH THE WORD "INIT..."
'ARE THOSE THAT RUN WHEN A RENDERER IS CHOSEN WHICH DOES NOT
'COINCIDE WITH THE ACTIVE LAYER'S CURRENT RENDERER.  THE OPTION
'CONTROLS ON THAT TAB ARE LOADED WITH DEFAULT VALUES THAT THE USER
'CAN CHANGE.
'  InitSingleSymbol()
'  InitUniqueValues()
'  InitClassBreaks()
'  InitStandardLabels()
'  InitNoOverlapLabels()
'  InitZRenderer()
'
'
'
Private Sub InitSingleSymbol()

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 = 5
    lblSSP(0).Caption = "点颜色"
    lblSSP(2).Caption = "尺寸"
    For i = 0 To 4
      cboSSP(0).AddItem strMarkerStyle(i)
    Next
    picSSP(0).BackColor = moGreen
    cboSSP(0).Text = strMarkerStyle(moSquareMarker)
    cboSSP(0).ListIndex = 1
    hsbSSP.Value = 0
    lblSSP(7).Caption = "0"
      cboSSP(1).Enabled = False
      cboSSP(2).Enabled = False
      lblSSP(3).Enabled = False
      lblSSP(4).Enabled = False
      lblSSP(5).Enabled = False
      lblSSP(7).Enabled = False
      hsbSSP.Enabled = False
    
  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 = 5
    lblSSP(0).Caption = "点颜色"
    lblSSP(2).Caption = "尺寸"
    For i = 0 To 4
      cboSSP(0).AddItem strMarkerStyle(i)
    Next
    picSSP(0).BackColor = moGreen
    cboSSP(0).Text = strMarkerStyle(moSquareMarker)
    cboSSP(0).ListIndex = 1
    hsbSSP.Value = 0
    lblSSP(7).Caption = "0"
      cboSSP(1).Enabled = False
      cboSSP(2).Enabled = False
      lblSSP(3).Enabled = False
      lblSSP(4).Enabled = False
      lblSSP(5).Enabled = False
      lblSSP(7).Enabled = False
      hsbSSP.Enabled = False
    
  Case moLine
    '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 = 1
    lblSSP(0).Caption = "线颜色"
    lblSSP(2).Caption = "线宽度"
    For i = 0 To 4
      cboSSP(0).AddItem strLineStyle(i)
    Next
    picSSP(0).BackColor = moBlue
    cboSSP(0).Text = strLineStyle(0)
    cboSSP(0).ListIndex = 0
  Case moPolygon
    '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
    txtSSP(0).Text = "1"
    lblSSP(0).Caption = "填充颜色"
    lblSSP(2).Caption = "边界宽度"
    For i = 0 To 10
      cboSSP(0).AddItem strFillStyle(i)
    Next
    picSSP(0).BackColor = moLightGray
    picSSP(1).BackColor = moBlack
    cboSSP(0).Text = strFillStyle(0)
    cboSSP(0).ListIndex = 0
    chkSSP.Value = 1
End Select
cmdApply.Enabled = True
cmdOK.Enabled = True

End Sub

Private Sub InitUniqueValues()

Dim i As Integer

'Load ComboBox with layer field names
cboUV.Clear
For i = 0 To tDesc.FieldCount - 1
  cboUV.AddItem tDesc.FieldName(i)
Next
cboUV.ListIndex = 0

fraUVouter.Caption = "图例预览"

'If a legend already exists, unload it
If picUV.Count > 1 Then
  For i = (picUV.Count - 1) To 1 Step -1
    Unload picUV(i)
    Unload lbluv(i)
  Next
End If
picUV(0).Visible = False
lbluv(0).Visible = False

cmdApply.Enabled = False
cmdOK.Enabled = False

chkUV.Visible = (lyr.shapeType = moShapeTypePolygon)
defaultfeature.Value = 1

End Sub

Private Sub InitClassBreaks()

Dim i As Integer
Dim fld As MapObjects2.Field

'Clear and reload ComboBoxes
cboCB(0).Clear
cboCB(0).AddItem "FeatureID"
cboCB(1).ListIndex = 3
For i = 0 To tDesc.FieldCount - 1
  Set fld = flds(tDesc.FieldName(i))
  If fld.Type = moDouble Or fld.Type = moLong Then
    cboCB(0).AddItem fld.Name
  End If
Next
cboCB(0).ListIndex = 0

'If a legend already exists, unload it
If picCBlegend.Count > 1 Then
  For i = (picCBlegend.Count - 1) To 1 Step -1
    Unload picCBlegend(i)
    Unload lblcblegend(i)
    Unload txtcblegend(i)
  Next
End If
picCBlegend(0).Visible = False
lblcblegend(0).Visible = False
txtcblegend(0).Visible = False

cmdApply.Enabled = False
cmdOK.Enabled = False

chkCB.Visible = (lyr.shapeType = moShapeTypePolygon)

End Sub
Private Sub initgr()

Dim i As Integer
For i = 0 To txtgr.Count - 1
    txtgr(i).Text = ""
    txtgr(i).Locked = True
Next i
cmdApply.Enabled = False
cmdOK.Enabled = False
End Sub

Private Sub InitStandardLabels()

Dim i As Integer
cboSL(0).Clear
cboSL(3).Clear
cboSL(4).Clear
For i = 0 To tDesc.FieldCount - 1
  cboSL(0).AddItem tDesc.FieldName(i)
  If tDesc.FieldType(i) = moLong Or _
     tDesc.FieldType(i) = moDouble Then
    cboSL(3).AddItem tDesc.FieldName(i)
    cboSL(4).AddItem tDesc.FieldName(i)
  End If
Next
cboSL(0).ListIndex = 0
cboSL(1).ListIndex = 1
cboSL(2).ListIndex = 1
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



'
'
'
'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 = "点颜色"
    lblSSP(2).Caption = "尺寸"
    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