📄 form1.frm
字号:
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty TitleStyle.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 32.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
DefaultStyle.TextFontBackColor= 16777215
DefaultStyle.SupportsBitmapSymbols= -1 'True
DefaultStyle.SymbolChar= 55
DefaultStyle.SymbolFontBackColor= 16777215
BeginProperty DefaultStyle.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty DefaultStyle.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Map Symbols"
Size = 14.25
Charset = 2
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
DefaultStyle.LineStyle= 1
DefaultStyle.LineWidth= 1
DefaultStyle.RegionColor= 16777215
DefaultStyle.LinePattern= 2
DefaultStyle.RegionBackColor= 16777215
DefaultStyle.RegionBorderStyle= 1
DefaultStyle.RegionBorderWidth= 1
HasProjectionInfo= -1 'True
NumericCoordsys = "Form1.frx":09C3
DisplayCoordsys = "Form1.frx":0AF3
NumDatasets = 0
TitleX = 5000
TitleY = 1000
TitleVisible = -1 'True
TitleEditable = -1 'True
TitlePostiion = 0
TitleBorder = -1 'True
End
Begin VB.CommandButton Command5
Caption = "制作专题图"
Height = 495
Left = 5880
TabIndex = 8
Top = 7080
Width = 1095
End
Begin VB.ComboBox Combo2
Height = 315
Left = 5040
TabIndex = 7
Text = "选择图层"
Top = 120
Width = 2295
End
Begin VB.ComboBox Combo1
Height = 315
ItemData = "Form1.frx":0C23
Left = 1320
List = "Form1.frx":0C25
TabIndex = 5
Text = "选择专题图类型"
Top = 120
Width = 1935
End
Begin VB.CommandButton Command4
Caption = "退出"
Height = 495
Left = 7560
TabIndex = 3
Top = 7080
Width = 975
End
Begin VB.CommandButton Command3
Caption = "漫游"
Height = 375
Left = 2520
TabIndex = 2
Top = 7200
Width = 855
End
Begin VB.CommandButton Command2
Caption = "缩小"
Height = 375
Left = 1680
TabIndex = 1
Top = 7200
Width = 735
End
Begin VB.CommandButton Command1
Caption = "放大"
Height = 375
Left = 720
TabIndex = 0
Top = 7200
Width = 855
End
Begin VB.Label Label2
Caption = "绑定图层"
Height = 255
Left = 4200
TabIndex = 6
Top = 120
Width = 975
End
Begin VB.Label Label1
Caption = "专题类型"
Height = 255
Left = 360
TabIndex = 4
Top = 120
Width = 855
End
End
Attribute VB_Name = "main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const yw As Double = 0.0001, yh As Double = 0.0005, yy0 As Double = 0.00025, yx0 As Double = 0.00025, h As Double = 0.5
Private Sub Command1_Click()
Map1.CurrentTool = miZoomInTool
End Sub
Private Sub Command2_Click()
Map1.CurrentTool = miZoomOutTool
End Sub
Private Sub Command3_Click()
Map1.CurrentTool = miPanTool
End Sub
Private Sub Command4_Click()
Close All
End
End Sub
Private Sub Command5_Click()
'创建专题图层
Dim oDs As MapXLib.Dataset
Dim oLayer As MapXLib.Layer
Dim oTheme As MapXLib.Theme
Dim oFields As New MapXLib.Fields
Dim oField As MapXLib.Field
Dim oCoordSys As MapXLib.CoordSys
Dim strLayerName As String
Dim nType As Integer
Dim s As Integer
'改变投影系
Set oCoordSys = Map1.DisplayCoordSys.Clone
' SetCoordsys
'设置专题图层
strLayerName = GetThemeLayerName()
If strLayerName = "" Then
MsgBox "请选择绑定图层"
Exit Sub
End If
'设置专题绑定数据集
Set oLayer = Map1.Layers.Item(strLayerName)
Map1.DataSets.RemoveAll
Set oDs = Map1.DataSets.Add(miDataSetLayer, oLayer, oLayer.KeyField)
'获得专题图类型
nType = GetThemeType
If nType = -1 Or nType = 9 Then
MsgBox "请选择专题类型"
Exit Sub
End If
'设置专题图
oFields.RemoveAll
Set oField = oFields.Add(oDs.Fields.Item(2), "data1")
oDs.Themes.RemoveAll
If nType = 1 Or nType = 2 Then
oFields.Add oDs.Fields.Item(3), "data2"
Set oTheme = oDs.Themes.Add(nType, oFields)
ElseIf nType = 9 Then
Set oTheme = oDs.Themes.Add(nType)
Else
Set oTheme = oDs.Themes.Add(nType, oField)
End If
'还原投影系
Set Map1.DisplayCoordSys = oCoordSys
'Set Map1.NumericCoordSys = oCoordSys
Set Map1.NumericCoordSys = Map1.DisplayCoordSys
End Sub
Sub SetCoordsys()
'设置投影系
Dim oDatum As New MapXLib.Datum
oDatum.Set 0, 0, 0, 0, 0, 0, 0, 0, 0
Map1.DisplayCoordSys.Set miLongLat, oDatum, miUnitDegree
Set Map1.NumericCoordSys = Map1.DisplayCoordSys
End Sub
Private Function GetThemeType() As Integer
'获得专题图类型
Dim nType As Integer, nIndex As Integer
nIndex = Combo1.ListIndex
Select Case nIndex
Case 0 '范围图
nType = 0
Case 1 '柱状图
nType = 1
Case 2 '饼状图
nType = 2
Case 3 '等级符号图
nType = 3
Case 4 '点密度图
nType = 4
Case 5 '独立值图
nType = 5
Case 6 '自动专题图
nType = 6
Case 7 '标注范围专题图
nType = 7
Case 8 '标注独立值专题图
nType = 8
Case 9 '非专题图
nType = 9
Case Else '提示用户选择专题类型
nType = -1
End Select
GetThemeType = nType
End Function
Private Function GetThemeLayerName() As String
'获得专题图层名称
Dim strLayerName As String
Dim nIndex As Integer
nIndex = Combo2.ListIndex
If nIndex < 0 Then
strLayerName = ""
Else
strLayerName = Combo2.List(nIndex)
End If
GetThemeLayerName = strLayerName
End Function
Private Sub Form_Load()
Dim i As Integer, nLayerCount As Integer
'加载专题图类型
Combo1.AddItem "范围图", 0
Combo1.AddItem "柱状图", 1
Combo1.AddItem "饼状图", 2
Combo1.AddItem "等级符号图", 3
Combo1.AddItem "点密度图", 4
Combo1.AddItem "独立值图", 5
Combo1.AddItem "自动专题图", 6
Combo1.AddItem "标注范围专题图", 7
Combo1.AddItem "标注独立值专题图", 8
Combo1.AddItem "非专题图", 9
'加载图层列表
If Map1.Layers.Count > 0 Then
nLayerCount = Map1.Layers.Count
For i = 1 To nLayerCount
Combo2.AddItem Map1.Layers.Item(i).Name, i - 1
Next
End If
End Sub
Private Sub Map2_Click()
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -