📄 frmlayerdlg.frm
字号:
Map.Layers.Layer4.LabelProperties.Position= 0
Map.Layers.Layer4.LabelProperties.Parallel= 0 'False
Map.Layers.Layer4.LabelProperties.LabelAlong= 0
Map.Layers.Layer4.LabelProperties.PartialSegments= 0 'False
Map.Layers.Layer4.LabelProperties.Style.TextFontBackColor= 16777215
Map.Layers.Layer4.LabelProperties.Style.SymbolChar= 0
BeginProperty Map.Layers.Layer4.LabelProperties.Style.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Map.Layers.Layer4.LabelProperties.Style.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Map.Layers.Layer4.LabelProperties.Style.LineStyle= 1
Map.Layers.Layer4.LabelProperties.Style.LineWidth= 1
Map.NumericCoordSys.ProjectionInfo= "frmlayerdlg.frx":0000
Map.DisplayCoordSys.ProjectionInfo= "frmlayerdlg.frx":0130
Map.Zoom = 5513.00000000002
Map.CenterX = 21.0569445434065
Map.CenterY = 53.7214884870928
FeatureEditMode = 1
End
Begin MSComDlg.CommonDialog cmndlg
Left = 4320
Top = 2640
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.ListBox Lstlayers
Appearance = 0 'Flat
Height = 3180
ItemData = "frmlayerdlg.frx":0260
Left = 1560
List = "frmlayerdlg.frx":0262
Style = 1 'Checkbox
TabIndex = 15
Top = 360
Width = 5415
End
Begin VB.ListBox Lstautolabel
Appearance = 0 'Flat
Height = 3180
ItemData = "frmlayerdlg.frx":0264
Left = 1200
List = "frmlayerdlg.frx":0266
Style = 1 'Checkbox
TabIndex = 14
Top = 360
Width = 375
End
Begin VB.ListBox lsteditable
Appearance = 0 'Flat
Height = 3180
ItemData = "frmlayerdlg.frx":0268
Left = 480
List = "frmlayerdlg.frx":026A
Style = 1 'Checkbox
TabIndex = 13
Top = 360
Width = 375
End
Begin VB.ListBox Lstselectable
Appearance = 0 'Flat
Height = 3180
ItemData = "frmlayerdlg.frx":026C
Left = 840
List = "frmlayerdlg.frx":026E
Style = 1 'Checkbox
TabIndex = 12
Top = 360
Width = 375
End
Begin VB.ListBox lstvisible
Appearance = 0 'Flat
Height = 3180
ItemData = "frmlayerdlg.frx":0270
Left = 120
List = "frmlayerdlg.frx":0272
Style = 1 'Checkbox
TabIndex = 11
Top = 360
Width = 375
End
Begin VB.CommandButton cmdcancel
Caption = "取消"
Height = 495
Left = 7320
TabIndex = 10
Top = 1320
Width = 1215
End
Begin VB.CommandButton cmdok
Caption = "确定"
Height = 495
Left = 7320
TabIndex = 9
Top = 480
Width = 1215
End
Begin VB.CommandButton cmdlabel
Caption = "标注 "
Height = 495
Left = 7320
TabIndex = 8
Top = 4680
Width = 1215
End
Begin VB.CommandButton cmddisplay
Caption = "显示 "
Height = 495
Left = 7320
TabIndex = 7
Top = 4080
Width = 1215
End
Begin VB.Frame frasetting
Caption = "设置"
Height = 1695
Left = 7080
TabIndex = 6
Top = 3720
Width = 1695
End
Begin VB.CommandButton cmddown
Caption = "下(&W)"
Height = 495
Left = 5520
TabIndex = 5
Top = 4800
Width = 1215
End
Begin VB.CommandButton cmdup
Caption = "上(&U)"
Height = 495
Left = 4080
TabIndex = 4
Top = 4800
Width = 1215
End
Begin VB.Frame fraposition
Caption = "位置 "
Height = 855
Left = 3840
TabIndex = 3
Top = 4560
Width = 3135
End
Begin VB.CommandButton cmdremovelayer
Caption = "删除(&R)"
Height = 495
Left = 2040
TabIndex = 2
Top = 4800
Width = 1215
End
Begin VB.CommandButton cmdaddlayer
Caption = "增加(&A)"
Height = 495
Left = 480
TabIndex = 1
Top = 4800
Width = 1215
End
Begin VB.Frame fralayers
Caption = "图层 "
Height = 855
Left = 240
TabIndex = 0
Top = 4560
Width = 3255
End
Begin VB.PictureBox picList
Height = 3315
Left = 60
ScaleHeight = 3255
ScaleWidth = 6915
TabIndex = 17
Top = 300
Width = 6975
End
Begin VB.Image Imgselect
Appearance = 0 'Flat
Height = 240
Left = 960
Picture = "frmlayerdlg.frx":0274
Top = 120
Width = 240
End
End
Attribute VB_Name = "frmlayerdlg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'定义全局变量，变量的第一个字母用M
Public m_intDispModifiedLyrCount As Integer
Public m_intLPModifiedLyrCount As Integer
'进入层控制对话框前的insertionlayer
Private m_PrevInsertionLayer As MapXLib.Layer
'是否为鼠标单击触发的ItemCheck事件，用于曾列表框各项交换位置
Private m_BlnIsMouseClick As Boolean
'装载地图
Private Type AddRemoveLayerInfo
layername As String
filepath As String
End Type
'记录用户删除的图层
Private m_audtRemovedLyrInfo() As AddRemoveLayerInfo
Private m_intRemovedLyrCount As Integer
'记录用户添加的图层
Private m_audtAddedLyrInfo() As AddRemoveLayerInfo
Private m_intAddedLyrCount As Integer
Private m_BlnIsFormLoaded As Boolean
'返回地图集中所包含图层文件的路径
Private m_strTabFilesPath() As String
Private Function FindLayerInMap(ByVal layername As String, ByVal srcmap As MapXLib.Map) As Integer
Dim i As Integer
FindLayerInMap = 0
For i = 1 To srcmap.Layers.Count
If srcmap.Layers(i).Name = layername Then
FindLayerInMap = i
Exit For
End If
Next i
End Function
Private Sub SetDipLabelCmdState()
If g_Map.Layers.Count > 0 Then
cmddisplay.Enabled = True
cmdlabel.Enabled = True
Else
cmddisplay.Enabled = False
cmdlabel.Enabled = False
End If
If Lstlayers.ListCount = 0 Then
cmddisplay.Enabled = False
cmdlabel.Enabled = False
End If
End Sub
Private Sub cmdaddlayer_Click()
Dim lyrinew As New MapXLib.LayerInfo
Dim strnewlayername As String
Dim strexistinglayername As String
Dim intnewlayernamelen As Integer
Dim intexistinglayernamelen As Integer
Dim strremain As String
Dim intrepeatecount As Integer
Dim blnaddremovedtab As Boolean
Dim blnaddlayerenabled As Boolean
Dim intindexmark As Integer
Dim intLayerpos As Integer
Dim i As Integer
cmndlg.FileName = ""
cmndlg.DialogTitle = "打开表文件"
cmndlg.DefaultExt = "tab"
cmndlg.Filter = "Mapinfo表文件(*.tab)|*.tab"
cmndlg.ShowOpen
If cmndlg.FileName = "" Then
Exit Sub
End If
blnaddremovedtab = False
'检查待添加图层是否在地图集中已存在
If istabfilealreadyexisting(cmndlg.FileName) Then
'检查待添加图层是否在进入层控制后已经北添加过，若是，禁止加载
blnaddlayerenabled = True
For i = 1 To m_intAddedLyrCount
If cmndlg.FileName = m_audtAddedLyrInfo(i).filepath Then
blnaddlayerenabled = False
Exit For
End If
Next i
Else
'检查讨添加的图层是否为进入层控制后被卸载的图层，若是，允许加载
blnaddlayerenabled = False
For i = 1 To m_intRemovedLyrCount
If cmndlg.FileName = m_audtRemovedLyrInfo(i).filepath Then
blnaddlayerenabled = True
intindexmark = i
Exit For
End If
Next i
End If
If blnaddlayerenabled Then
If blnaddremovedtab Then
'待获取添加图层层名
strnewlayername = m_audtRemovedLyrInfo(intindexmark).layername
'待添加图层为进入层控制后被删除的图层，从删除图层记录m_arrremovedlayernames中去除该层的记录
updateremovedlayersrecord "", True, intindexmark
Else
'获取待添加图层层名（通过将新层临时加入地图集中实现）
lyrinew.Type = miLayerInfoTypeTab
lyrinew.AddParameter "filespec", cmndlg.FileName
g_Map.Layers.Add lyrinew, 1
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -