📄 layersymbol.frm
字号:
Top = 3000
Width = 1815
End
Begin VB.Label lblSL
Caption = "YOffset field"
Height = 255
Index = 5
Left = -72000
TabIndex = 61
Top = 3000
Width = 1815
End
Begin VB.Label lblSL
Caption = "Rotation:"
Height = 255
Index = 6
Left = -72000
TabIndex = 60
Top = 2280
Width = 735
End
Begin VB.Label lblSL
BackColor = &H80000009&
Caption = "0"
Height = 255
Index = 7
Left = -71280
TabIndex = 59
Top = 2280
Width = 375
End
Begin VB.Label lblCB
Caption = "Numeric field:"
Height = 255
Index = 0
Left = -74760
TabIndex = 46
Top = 600
Width = 1215
End
Begin VB.Label lblCB
Caption = "Number of classes:"
Height = 255
Index = 1
Left = -71880
TabIndex = 45
Top = 600
Width = 1455
End
Begin VB.Label lblCB
Caption = "Color ramp:"
Height = 255
Index = 2
Left = -70680
TabIndex = 44
Top = 1560
Width = 855
End
Begin VB.Label lblCB
Alignment = 1 'Right Justify
Caption = "Start:"
Height = 255
Index = 3
Left = -70920
TabIndex = 43
Top = 1920
Width = 495
End
Begin VB.Label lblCB
Alignment = 1 'Right Justify
Caption = "End:"
Height = 255
Index = 4
Left = -70920
TabIndex = 42
Top = 2280
Width = 495
End
Begin VB.Label lblUVFieldlist
Caption = "Field:"
Height = 255
Left = -71400
TabIndex = 32
Top = 1125
Width = 1695
End
Begin VB.Label lblSSP
Alignment = 1 'Right Justify
Caption = "Color:"
Height = 255
Index = 0
Left = -74160
TabIndex = 23
Top = 1200
Width = 1215
End
Begin VB.Label lblSSP
Alignment = 1 'Right Justify
Caption = "Style:"
Height = 255
Index = 1
Left = -73680
TabIndex = 22
Top = 1560
Width = 735
End
Begin VB.Label lblSSP
Alignment = 1 'Right Justify
Caption = "Character Index:"
Enabled = 0 'False
Height = 255
Index = 4
Left = -74160
TabIndex = 21
Top = 2640
Width = 1215
End
Begin VB.Label lblSSP
Caption = ":Outline Color"
Height = 255
Index = 6
Left = -71160
TabIndex = 20
Top = 1200
Width = 1215
End
Begin VB.Label lblSSP
Alignment = 1 'Right Justify
Caption = "Rotation:"
Enabled = 0 'False
Height = 255
Index = 5
Left = -73800
TabIndex = 19
Top = 3000
Width = 855
End
Begin VB.Label lblSSP
Alignment = 1 'Right Justify
Caption = "Font:"
Enabled = 0 'False
Height = 255
Index = 3
Left = -74160
TabIndex = 18
Top = 2280
Width = 1215
End
Begin VB.Label lblSSP
Alignment = 1 'Right Justify
Caption = "Size:"
Height = 255
Index = 2
Left = -74160
TabIndex = 17
Top = 1920
Width = 1215
End
Begin VB.Label lblSSP
Alignment = 1 'Right Justify
Caption = "0"
Enabled = 0 'False
Height = 255
Index = 7
Left = -73440
TabIndex = 16
Top = 3240
Width = 375
End
End
Begin MSComDlg.CommonDialog cdlgLayerProp
Left = 0
Top = 5760
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.TextBox txtLayerName
Height = 285
Left = 1200
TabIndex = 5
Top = 80
Width = 3495
End
Begin VB.CommandButton cmdApply
Caption = "Apply"
Height = 375
Left = 4680
TabIndex = 3
Top = 5760
Width = 1095
End
Begin VB.CommandButton cmdCancel
Caption = "Cancel"
Height = 375
Left = 4680
TabIndex = 2
Top = 6240
Width = 1095
End
Begin VB.CommandButton cmdOK
Caption = "OK"
Height = 375
Left = 4680
TabIndex = 1
Top = 6720
Width = 1095
End
Begin VB.PictureBox picLayerProp
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1095
Left = 720
Picture = "LayerSymbol.frx":0201
ScaleHeight = 1095
ScaleWidth = 3015
TabIndex = 0
Top = 5880
Width = 3015
End
Begin VB.Label lblPanelDesc
Caption = "The Single Symbol classification displays all the features in a layer with the same symbol."
Height = 495
Left = 120
TabIndex = 6
Top = 480
Width = 5535
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Layer name:"
Height = 255
Left = 120
TabIndex = 4
Top = 120
Width = 975
End
Begin VB.Line Line1
BorderColor = &H80000005&
BorderStyle = 6 'Inside Solid
X1 = -120
X2 = 6000
Y1 = 5640
Y2 = 5640
End
End
Attribute VB_Name = "frmLayerSymbol"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim strMarkerStyle(4) As String
Dim strLineStyle(4) As String
Dim strFillStyle(10) As String
Dim strPanelDesc(5) As String
Dim lyr As MapObjects2.MapLayer
Dim recs As MapObjects2.Recordset
Dim tDesc As MapObjects2.TableDesc
Dim flds As MapObjects2.Fields
Dim a As Integer
Dim vmr As MapObjects2.ValueMapRenderer
Dim cbr As MapObjects2.ClassBreaksRenderer
Dim lr As MapObjects2.LabelRenderer
Dim lp As MapObjects2.LabelPlacer
Dim zRend As MapObjects2.ZRenderer
Dim colorMask, colorText As Long
Dim justOpened As Boolean
Private Sub Form_Load()
Dim i As Integer
Dim fnt As New StdFont
'Position this form into the top right
'corner of the screen
Me.Top = 0
Me.Left = Screen.Width - Me.Width
colorText = moBlack
colorMask = moWhite
picLayerProp.Picture = LoadPicture(App.path & "\bitmaps\class.bmp")
Set lyr = frmMain.g_ActiveLayer
'If lyr Is Nothing Then
' MsgBox "lyr is nothing"
'End If
Set recs = lyr.Records
Set tDesc = recs.TableDesc
Set flds = recs.Fields
frmLayerSymbol.Caption = "Symbol properties for the " & UCase(lyr.Name) & " layer."
strPanelDesc(0) = "The Single Symbol classification displays all the features in a layer with the same symbol."
strPanelDesc(1) = "The Unique Values classification displays features by applying a symbol to each unique value for a specified field."
strPanelDesc(2) = "The Class Breaks classification applies symbols to a set of discrete values."
strPanelDesc(3) = "The Standard Labels classification draws text for a specified field."
strPanelDesc(4) = "The No Overlapping Labels classication draws text for a specified field and attempts to resolve overlapping and crowding of labels."
strPanelDesc(5) = "The Elevation classification draws features according to their Z values, if the data supports it."
txtLayerName = lyr.Name
strMarkerStyle(0) = "Circle marker"
strMarkerStyle(1) = "Square marker"
strMarkerStyle(2) = "Triangle marker"
strMarkerStyle(3) = "Cross marker"
strMarkerStyle(4) = "TrueType marker"
strLineStyle(0) = "Solid line"
strLineStyle(1) = "Dash line"
strLineStyle(2) = "Dot line"
strLineStyle(3) = "Dash dot line"
strLineStyle(4) = "Dash dot dot line"
strFillStyle(0) = "Solid fill"
strFillStyle(1) = "Transparent fill"
strFillStyle(2) = "Horizontal fill"
strFillStyle(3) = "Vertical fill"
strFillStyle(4) = "Upward diagonal"
strFillStyle(5) = "Downward diagonal"
strFillStyle(6) = "Cross fill"
strFillStyle(7) = "Diagonal cross fill"
strFillStyle(8) = "Light gray fill"
strFillStyle(9) = "Gray fill"
strFillStyle(10) = "Dark gray fill"
justOpened = True
'Read the contents of the active layer's Renderer property.
'Run one of the "Load..." procedures to populate the appropriate
'tab with the current renderer's properties.
Select Case True
Case lyr.Renderer Is Nothing
sstLayerProp.Tab = 0
Call LoadSingleSymbol
Case TypeOf lyr.Renderer Is MapObjects2.ValueMapRenderer
sstLayerProp.Tab = 1
Call LoadUniqueValues
Case TypeOf lyr.Renderer Is MapObjects2.ClassBreaksRenderer
sstLayerProp.Tab = 2
Call LoadClassBreaks
Case TypeOf lyr.Renderer Is MapObjects2.LabelRenderer
sstLayerProp.Tab = 3
Call LoadStandardLabels
Case TypeOf lyr.Renderer Is MapObjects2.LabelPlacer
sstLayerProp.Tab = 4
colorMask = lyr.Renderer.MaskColor
Call LoadNoOverlapLabels
Case TypeOf lyr.Renderer Is MapObjects2.ZRenderer
sstLayerProp.Tab = 5
Call LoadZRenderer
Case Else
sstLayerProp.Tab = 0
Call LoadSingleSymbol
End Select
'If the active layer does not support Z shapes, disable
'the "Elevation" rendering tab.
If (InStr(lyr.tag, "[SHAPEFILZ]") = 0) And (InStr(lyr.tag, "[SDEZ]") = 0) Then
sstLayerProp.TabEnabled(5) = False
End If
End Sub
Private Sub cmdApply_Click()
'When the user hits the Apply button (or the OK button)
'read the option controls on the active tab, and use
'them to build a new renderer with which to draw the layer.
Select Case sstLayerProp.Tab
Case 0: Call ApplySingleSymbol
Case 1: Call ApplyUniqueValues
Case 2: Call ApplyClassBreaks
Case 3: Call ApplyStandardLabels
Case 4: Call ApplyNoOverlapLabels
Case 5: Call ApplyZRenderer
End Select
'Rename the layer with the contents of txtLayerName.Text
lyr.Name = txtLayerName.text
'Refresh the map legend
frmMain.legMapDisp.LoadLegend
'Redraw the map
frmMain.mapDisp.Refresh
End Sub
Private Sub cmdCancel_Click()
'Throw away all work on this form.
'Layer retains original rendering information.
Unload frmLayerSymbol
End Sub
Private Sub cmdOK_Click()
'Use Apply, then unload
Call cmdApply_Click
Unload frmLayerSymbol
End Sub
Private Sub cmdNOL_Click()
'Choose font properties for the LabelPlacer
cdlgLayerProp.color = colorText
cdlgLayerProp.Flags = cdlCFEffects Or cdlCFBoth
cdlgLayerProp.ShowFont
txtNOL.ForeColor = cdlgLayerProp.color
txtNOL.text = cdlgLayerProp.FontName
colorText = cdlgLayerProp.color
End Sub
Private Sub cmdSL_Click()
'Choose font properties for the LabelRenderer
cdlgLayerProp.Flags = cdlCFEffects Or cdlCFBoth
cdlgLayerProp.ShowFont
txtSL.ForeColor = cdlgLayerProp.color
txtSL.text = cdlgLayerProp.FontName
End Sub
Private Sub cmdCB_Click()
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -