frmlayerdlg.frm

这是一个 信息查询的小程序

Lstautolabel.Clear


'添加当前地图集中所有层名至列表框
If g_Map.Layers.Count > 0 Then
  Lstlayers.Enabled = True
  lstvisible.Enabled = True
  lsteditable.Enabled = True
  Lstselectable.Enabled = True
  Lstautolabel.Enabled = True



For i = 1 To g_Map.Layers.Count
 strLayerName = g_Map.Layers.Item(i).Name
 Lstlayers.AddItem strLayerName, i - 1
 lstvisible.AddItem "", i - 1
 lsteditable.AddItem "", i - 1
 Lstselectable.AddItem "", i - 1
 Lstautolabel.AddItem "", i - 1



 lstvisible.Selected(i - 1) = g_Map.Layers(i).Visible
 lsteditable.Selected(i - 1) = g_Map.Layers(i).Editable
 Lstselectable.Selected(i - 1) = g_Map.Layers(i).Selectable
 Lstautolabel.Selected(i - 1) = g_Map.Layers(i).AutoLabel

Next i
Else
Lstlayers.Enabled = True
  lstvisible.Enabled = False
  lsteditable.Enabled = False
  Lstselectable.Enabled = False
  Lstautolabel.Enabled = False
End If



Lstlayers.ListIndex = 0
  lstvisible.ListIndex = 0
  lsteditable.ListIndex = 0
  Lstselectable.ListIndex = 0
  Lstautolabel.ListIndex = 0
  
'调用该事件设置排序按钮状态
Call Lstlayers_Click


'设置显示和标注按钮状态
SetDipLabelCmdState



'保存原insertionlayer,以便在用户按取消键后恢复原来的insertionlayer
Set m_PrevInsertionLayer = g_Map.Layers.InsertionLayer


'首先去除地图中的insertionlayer，insertionlayer的可编辑状态不能改变，只能为true
Set g_Map.Layers.InsertionLayer = Nothing


'获取地图集中所含层文件
GetTabFilesingst g_Map



m_intDispModifiedLyrCount = 0 '这里也没有大写，是有错误的
m_intLPModifiedLyrCount = 0


m_intRemovedLyrCount = 0 '这里也是没有大写的
m_intAddedLyrCount = 0



m_BlnIsMouseClick = True
End Sub
'从地图集文件（.gst）中获取其所含图层文件（.tab）的路径
'Private Sub gettabfilesingst(ByVal gstpath As String)
  ' Dim strInputChar As String
  ' Dim strTarget  As String
  ' Dim strLayerPath As String
  ' Dim strGstFolderPath As String
  ' Dim blnRecordEnable As Boolean
  ' Dim intCount As Integer
   
   
   'intCount = 0
  ' strLayerPath = ""
  ' blnRecordEnable = False
   
   
   'Open gstpath For Input Access Read As #1
   'Do While Not EOF(1)
    ' strInputChar = Input(1, #1)
     'If strInputChar = "=" Then
    '    blnRecordEnable = True
    ' ElseIf strInputChar <> vbCr Then
     '   If blnRecordEnable Then
     '      strLayerPath = strLayerPath & strInputChar
     '    End If
     ' ElseIf strInputChar = vbCr Then
      '  If blnRecordEnable Then
        '   strLayerPath = Trim(strLayerPath)
         '  strLayerPath = Mid(strLayerPath, 2)
         '  strLayerPath = Left(strLayerPath, Len(strLayerPath) - 1)
         '  strTarget = Right(strLayerPath, 4)
         '  If UCase(strTarget) = ".tab" Then
             '得到.tab文件所在完整路径strlayerpath
            ' strGstFolderPath = getupperfolderpath(gstpath)
            ' 'strLayerPath = makefullpath(strGstFolderPath, strLayerPath)
             
             
          '   incount = incount + 1
          '   ReDim Preserve m_strtabfiles(1 To intCount)
          '   m_strtabfiles(intCount) = strLayerPath
        '   End If
           
           
           
          ' blnRecordEnable = False
         '  strLayerPath = ""
     '  End If
     'Loop
    ' Close #1
  ' End Sub
  Private Sub GetTabFilesingst(ByVal GST As MapXLib.Map)
Dim i As Integer
If GST.Layers.Count > 0 Then
ReDim m_strTabFilesPath(1 To GST.Layers.Count)
For i = 1 To GST.Layers.Count
m_strTabFilesPath(i) = GST.Layers(i).FileSpec
Next i
End If

  End Sub
   '判断图层文件是否在地图集中存在
Private Function istabfilealreadyexisting(ByVal tabpath As String) As Boolean
      Dim i As Integer
      
      
      istabfilealreadyexisting = True
      If g_Map.Layers.Count > 0 Then
         For i = 1 To UBound(m_strTabFilesPath)
            If m_strTabFilesPath(i) = tabpath Then
               istabfilealreadyexisting = False
                 Exit Function
             End If
          Next i
        End If
     End Function
      '更新被删除图层文件记录
  Private Sub updateremovedlayersrecord(ByVal layername As String, ByVal isremoving As Boolean, Optional index As Integer = 0)
      Dim intposmark As Integer
      Dim i As Integer
      
      If isremoving Then
         For i = index To (m_intRemovedLyrCount - 1)
            m_audtRemovedLyrInfo(i) = m_audtRemovedLyrInfo(i + 1)
         Next i
         m_intRemovedLyrCount = m_intRemovedLyrCount - 1
         If m_intRemovedLyrCount > 0 Then
            ReDim Preserve m_audtRemovedLyrInfo(1 To m_intRemovedLyrCount)
          End If
      Else
       m_intRemovedLyrCount = m_intRemovedLyrCount + 1
       ReDim Preserve m_audtRemovedLyrInfo(1 To m_intRemovedLyrCount)
       m_audtRemovedLyrInfo(m_intRemovedLyrCount).layername = layername
       m_audtRemovedLyrInfo(m_intRemovedLyrCount).filepath = g_Map.Layers.Item(layername).FileSpec
      End If
      
      End Sub
       '更新被添加图层文件记录
      Private Sub updateaddedlayersrecord(ByVal layername_path As String, ByVal isremoveing As Boolean, Optional index As Integer, Optional newlayername As String)
        Dim i As Integer
        
        
        If isremoveing Then
           For i = index To (m_intAddedLyrCount - 1)
              m_audtAddedLyrInfo(i) = m_audtAddedLyrInfo(i + 1)
           Next i
           m_intAddedLyrCount = m_intAddedLyrCount - 1
           If m_intAddedLyrCount > 0 Then
              ReDim Preserve m_audtAddedLyrInfo(1 To m_intAddedLyrCount)
            End If
         Else
         m_intAddedLyrCount = m_intAddedLyrCount + 1
          ReDim Preserve m_audtAddedLyrInfo(1 To m_intAddedLyrCount)
          m_audtAddedLyrInfo(m_intAddedLyrCount).filepath = layername_path
          m_audtAddedLyrInfo(m_intAddedLyrCount).layername = newlayername
        End If
      End Sub



Private Sub g_Map_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
frmlayerdlg.Show
End Sub

Private Sub Lstautolabel_Click()
'控制图层是否自动标注
End Sub



Private Sub Lstautolabel_ItemCheck(Item As Integer)
If m_BlnIsMouseClick Then
'只有当该层可见时，才能设置其是否可自动标注
       If lstvisible.Selected(Item) Then
        Lstlayers.ListIndex = Item


       '只有一个层处于可编辑状态
      Else
       lsteditable.Selected(Item) = False
    
    End If

End If
End Sub

Private Sub lsteditable_ItemCheck(Item As Integer)
Dim strLayerName As String
Dim blneditabletouser As Boolean
Dim i As Integer


If m_BlnIsMouseClick Then
'只有当该层可见时，才能设置其是否可编辑
       If lstvisible.Selected(Item) Then
        Lstlayers.ListIndex = Item


       '只有一个层处于可编辑状态
           For i = 0 To lsteditable.ListCount - 1
             If i <> Item Then
             lsteditable.Selected(i) = False
             End If

           Next i


             '可编辑层中对象必须能被选中
            If lsteditable.Selected(Item) Then
           Lstselectable.Selected(Item) = True

            End If
      Else
       lsteditable.Selected(Item) = False
    
    End If

End If

End Sub


Private Sub Lstlayers_Click()
'响应图层列表框单击事件
cmdup.Enabled = True
      cmddown.Enabled = True
      If Lstlayers.ListIndex = 0 Then
        cmdup.Enabled = False
       End If
      If Lstlayers.ListIndex = Lstlayers.ListCount - 1 Then
        cmddown.Enabled = False
       End If
       
       '列表框为空时，禁止图层位置调整按钮
        If Lstlayers.ListIndex = -1 Then
          cmdup.Enabled = False
          cmddown.Enabled = False
        End If
        
End Sub

Private Sub Lstlayers_Scroll()
'响应图层列表框滚动事件，使各列表框的滚动同步
Dim inttopindex As Integer
      
      
      inttopindex = Lstlayers.TopIndex
      
      
      lstvisible.TopIndex = inttopindex
      lsteditable.TopIndex = inttopindex
      Lstselectable.TopIndex = inttopindex
      Lstautolabel.TopIndex = inttopindex
End Sub

Private Sub Lstselectable_ItemCheck(Item As Integer)
If m_BlnIsMouseClick Then
'只有当该层可见时，才能设置其是否可被选中
       If lstvisible.Selected(Item) Then
        Lstlayers.ListIndex = Item
             '可编辑层中对象必须能被选中
            If lsteditable.Selected(Item) Then
           Lstselectable.Selected(Item) = True

            End If
      Else
       lsteditable.Selected(Item) = False
    
    End If

End If
End Sub

Private Sub lstvisible_ItemCheck(Item As Integer)
Dim strLayerName As String
Dim blneditabletouser As Boolean
Dim i As Integer

If m_BlnIsMouseClick Then
    
        Lstlayers.ListIndex = Item
       '
           If lstvisible.Selected(Item) Then
           
           Lstselectable.Selected(Item) = False

           lsteditable.Selected(Item) = False

           Lstautolabel.Selected(Item) = False

End If
End If









End Sub