📄 frmdisplayoptions.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmDisplayOptions
Caption = "显示属性"
ClientHeight = 4545
ClientLeft = 3000
ClientTop = 2400
ClientWidth = 6705
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 4545
ScaleWidth = 6705
Begin MSComDlg.CommonDialog cmndlg
Left = 3120
Top = 2040
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.PictureBox picLineStyle
Height = 735
Left = 420
ScaleHeight = 45
ScaleMode = 3 'Pixel
ScaleWidth = 53
TabIndex = 19
Top = 1080
Width = 855
End
Begin VB.CommandButton cmdSymbolStyle
Appearance = 0 'Flat
Caption = "符号(&Y)"
Height = 495
Left = 2760
Style = 1 'Graphical
TabIndex = 9
Top = 2040
Width = 975
End
Begin VB.TextBox txtZoomMax
Height = 270
Left = 1800
TabIndex = 14
Top = 3960
Width = 1455
End
Begin VB.TextBox txtZoomMin
Height = 270
Left = 1800
TabIndex = 13
Top = 3480
Width = 1455
End
Begin VB.CommandButton cmdTextStyle
Appearance = 0 'Flat
Caption = "文本(&T)"
Height = 495
Left = 3960
Style = 1 'Graphical
TabIndex = 12
Top = 2040
Width = 975
End
Begin VB.CommandButton cmdRegionStyle
Appearance = 0 'Flat
Caption = "区域(&R)"
Height = 495
Left = 1560
Style = 1 'Graphical
TabIndex = 11
Top = 2040
Width = 975
End
Begin VB.CommandButton cmdLineStyle
Appearance = 0 'Flat
Caption = "线(&L)"
Height = 495
Left = 360
Style = 1 'Graphical
TabIndex = 10
Top = 2040
Width = 975
End
Begin VB.CheckBox chkOverrideStyle
Caption = "样式替换"
Height = 180
Left = 240
TabIndex = 8
Top = 480
Width = 1215
End
Begin VB.CheckBox chkShowCentroids
Caption = "显示中心(&C)"
Height = 255
Left = 4680
TabIndex = 7
Top = 3960
Width = 1935
End
Begin VB.CheckBox chkShowNodes
Caption = "显示节点(&N)"
Height = 255
Left = 4680
TabIndex = 6
Top = 3480
Width = 1815
End
Begin VB.CheckBox chkShowLineDirection
Caption = "显示线段方向(&L)"
Height = 255
Left = 4680
TabIndex = 5
Top = 3000
Width = 1815
End
Begin VB.CheckBox chkZoomLayer
Caption = "在缩放范围内显示(&Z)"
Height = 375
Left = 240
TabIndex = 4
Top = 3120
Width = 2175
End
Begin VB.CommandButton cmdCancel
Caption = "取消"
Height = 495
Left = 5280
TabIndex = 2
Top = 1080
Width = 1215
End
Begin VB.CommandButton cmdOk
Caption = "确定"
Height = 495
Left = 5310
TabIndex = 1
Top = 360
Width = 1215
End
Begin VB.Frame fraMode
Caption = "显示模式"
Height = 2415
Left = 120
TabIndex = 0
Top = 240
Width = 5055
Begin VB.PictureBox PicTextStyle
Height = 735
Left = 3900
ScaleHeight = 675
ScaleWidth = 795
TabIndex = 22
Top = 840
Width = 855
End
Begin VB.PictureBox PicSymbolStyle
Height = 735
Left = 2700
ScaleHeight = 675
ScaleWidth = 795
TabIndex = 21
Top = 840
Width = 855
End
Begin VB.PictureBox picRegionStyle
Height = 735
Left = 1500
ScaleHeight = 675
ScaleWidth = 795
TabIndex = 20
Top = 840
Width = 855
End
End
Begin VB.Frame fraZoom
Caption = "图层缩放"
Height = 1455
Left = 120
TabIndex = 3
Top = 2880
Width = 4335
Begin VB.Label lblUnitZoomMax
Caption = "公里"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3360
TabIndex = 18
Top = 1080
Width = 855
End
Begin VB.Label lblUnitZoomMin
Caption = "公里"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3360
TabIndex = 17
Top = 600
Width = 735
End
Begin VB.Label lblZoomMax
Caption = "最大视野"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 600
TabIndex = 16
Top = 1080
Width = 840
End
Begin VB.Label lblZoomMin
Caption = "最小视野"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 600
TabIndex = 15
Top = 600
Width = 960
End
End
End
Attribute VB_Name = "frmdisPlayOptions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private m_strCurLayerName As String '当前层名
Private m_lyrCur As MapXLib.Layer '当前层
Private m_styNew As MapXLib.Style '修改后的层样式
'设置是否替换样式
Private Sub chkOverrideStyle_Click()
Dim blnvalue As Boolean
blnvalue = (chkOverrideStyle.Value = vbChecked)
cmdLineStyle.Enabled = blnvalue
cmdRegionStyle.Enabled = blnvalue
cmdSymbolStyle.Enabled = blnvalue
cmdTextStyle.Enabled = blnvalue
End Sub
Private Sub chkZoomLayer_Click()
If chkZoomLayer.Value = vbChecked Then
txtZoomMin.Enabled = True
txtZoomMax.Enabled = True
txtZoomMin.BackColor = vbWindowBackground
txtZoomMax.BackColor = vbWindowBackground
txtZoomMin.Text = CStr(m_lyrCur.ZoomMin)
txtZoomMax.Text = CStr(m_lyrCur.ZoomMax)
Else
txtZoomMin.Text = ""
txtZoomMax.Text = ""
txtZoomMin.Enabled = False
txtZoomMax.Enabled = False
txtZoomMin.BackColor = vbButtonFace
txtZoomMax.BackColor = vbButtonFace
End If
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdLineStyle_Click()
m_styNew.PickLine
End Sub
Private Sub cmdOk_Click()
Dim intItemIndex As Integer
'若设置了视野缩放范围，检查缩放值
If txtZoomMin.Enabled Then
If (Not IsNumeric(txtZoomMin.Text)) Or (Val(txtZoomMin.Text) < 0) Then
MsgBox "视野值必须为>0 的数字！！", vbOKOnly + vbExclamation
txtZoomMin.SetFocus
txtZoomMin.SelStart = 0
txtZoomMin.SelLength = Len(txtZoomMin.Text)
Exit Sub
End If
End If
If txtZoomMax.Enabled Then
If Not IsNumeric(txtZoomMin.Text) Or (Val(txtZoomMin.Text) < 0) Then
MsgBox "视野值必须为>0 的数字！！", vbOKOnly + vbExclamation
txtZoomamx.SetFocus
txtZoomMax.SelStart = 0
txtZoomMax.SelLength = Len(txtZoomMax.Text)
Exit Sub
End If
End If
'检查当前层进入层控制对话框之后之否已经被修改国，若是，得到该层在记录修改信息的数组g_audtdispmodifiedlyr
'中的位置；若是还没被修改过，则扩充数组g_audtdispmodifiedlyr，保存信的修改过的信息记录
intItemIndex = checklayer(m_strCurLayerName)
If intItemIndex = 0 Then
frmlayerdlg.m_intDispModifiedLyrCount = frmlayerdlg.m_intDispModifiedLyrCount + 1
intItemIndex = frmlayerdlg.m_intDispModifiedLyrCount
ReDim Preserve g_audtDispModifiedLyr(intItemIndex)
g_audtDispModifiedLyr(intItemIndex).layername = m_strCurLayerName
End If
'保存当前层显示修改信息
If chkOverrideStyle.Value = vbChecked Then
g_audtDispModifiedLyr(intItemIndex).ZoomLayer = True
g_audtDispModifiedLyr(intItemIndex).ZoomMin = Val(txtZoomMin.Text)
g_audtDispModifiedLyr(intItemIndex).ZoomMax = Val(txtZoomMax.Text)
Else
g_audtDispModifiedLyr(intItemIndex).ZoomLayer = False
End If
g_audtDispModifiedLyr(intItemIndex).ShowLineDirection = (chkShowLineDirection.Value = vbChecked)
g_audtDispModifiedLyr(intItemIndex).ShowNodes = (chkShowNodes.Value = vbChecked)
g_audtDispModifiedLyr(intItemIndex).ShouwCentroids = (chkShowCentroids.Value = vbChecked)
Unload Me
End Sub
Private Sub cmdRegionStyle_Click()
m_styNew.PickRegion
End Sub
Private Sub cmdSymbolStyle_Click()
m_styNew.PickSymbol
End Sub
Private Sub cmdTextStyle_Click()
m_styNew.PickText
End Sub
Private Sub Form_Load()
Dim intSelIndex As Integer
Dim strUnit As String
intSelIndex = frmlayerdlg.Lstlayers.ListIndex
m_strCurLayerName = frmlayerdlg.Lstlayers.List(intSelIndex)
Set m_lyrCur = frmlayerdlg.g_Map.Layers(m_strCurLayerName)
Set m_styNew = m_lyrCur.Style.Clone
cmdLineStyle.Enabled = False
cmdRegionStyle.Enabled = False
cmdSymbolStyle.Enabled = False
cmdTextStyle.Enabled = False
'判断当前层是否在一定视野范围内显示，设置相应复选框和文本框
If m_lyrCur.ZoomLayer Then
chkZoomLayer.Value = vbChecked
Else
chkZoomLayer.Value = vbUnchecked
End If
chkZoomLayer_Click
'图层缩放显示范围的单位为当前地图单位
Select Case frmlayerdlg.g_Map.MapUnit
Case miUnitMile
strUnit = "英里"
Case miUnitKilometer
strUnit = "公里"
Case miUnitInch
strUnit = "英寸"
Case miUnitFoot
strUnit = "英尺"
Case miUnitYard
strUnit = "码"
Case miUnitMillimeter
strUnit = "毫米"
Case miUnitCentimeter
strUnit = "厘米"
Case miUnitMeter
strUnit = "米"
Case miUnitSurveyFoot
strUnit = "测量英尺"
Case miUnitNauticalMile
strUnit = "海里"
Case miUnitTwip
strUnit = "缇"
Case miUnitPoint
strUnit = "磅"
Case miUnitPica
strUnit = "Pica"
Case miUnitDegree
strUnit = "度"
Case miUnitLink
strUnit = "令"
Case miUnitChain
strUnit = "链"
Case miUnitRod
strUnit = "杆"
End Select
lblUnitZoomMin.Caption = strUnit
lblUnitZoomMax.Caption = strUnit
'判断当前层是否显示线段方向，甚至相应复选框
If m_lyrCur.ShowLineDirection Then
chkShowLineDirection.Value = vbChecked
Else
chkShowLineDirection.Value = vbUnchecked
End If
'判断当前层是否显示节点，甚至相应复选框
If m_lyrCur.ShowNodes Then
chkShowNodes.Value = vbChecked
Else
chkShowNodes.Value = vbUnchecked
End If
'判断当前层是否显示中心，甚至相应复选框
If m_lyrCur.ShowCentroids Then
chkShowCentroids.Value = vbChecked
Else
chkShowCentroids.Value = vbUnchecked
End If
Me.Caption = "显示属性" & m_strCurLayerName
'在修改图层样式时，禁止地图的自动刷新
frmlayerdlg.g_Map.AutoRedraw = False
End Sub
Private Sub Form_Paint()
Dim rect As New MapXLib.Rectangle
picLineStyle.Cls
picRegionStyle.Cls
PicSymbolStyle.Cls
PicTextStyle.Cls
rect.Set 0, 0, picRegionStyle.ScaleWidth, picRegionStyle.ScaleHeight
m_styNew.DrawRegionSample picRegionStyle.hDC, rect
rect.Set 0, 0, picLineStyle.ScaleWidth, picLineStyle.ScaleHeight
m_styNew.DrawLineSample picLineStyle.hDC, rect
rect.Set 0, 0, PicSymbolStyle.ScaleWidth, PicSymbolStyle.ScaleHeight
m_styNew.DrawSymbolSample PicSymbolStyle.hDC, rect
rect.Set 0, 0, PicTextStyle.ScaleWidth, PicTextStyle.ScaleHeight
m_styNew.DrawTextSample PicTextStyle.hDC, rect, "Text"
End Sub
Private Sub Form_Unload(Cancel As Integer)
frmlayerdlg.g_Map.AutoRedraw = True
End Sub
Private Function checklayer(layername As String) As Integer
Dim i As Integer
checklayer = 0
For i = 1 To frmlayerdlg.m_intDispModifiedLyrCount
If g_audtDispModifiedLyr(i).layername = layername Then
checklayer = i
End If
Next i
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -