frmlayerdlg.frm

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

            strnewlayername = g_Map.Layers.Item(1).Name

            '待添加图层文件不属于原有地图集，添加该文件至m_audtaddedlyrinfo
            updateaddedlayersrecord cmndlg.FileName, False, , strnewlayername


            '将临时加入地图集的新层删除
            g_Map.Layers.Remove 1
            End If

            '更新个列表框
            Lstlayers.AddItem strnewlayername, 0
            lstvisible.AddItem "", 0
            lsteditable.AddItem "", 0
            Lstselectable.AddItem "", 0
            Lstautolabel.AddItem "", 0
            Lstlayers.Enabled = True
            lstvisible.Enabled = True
            lsteditable.Enabled = True
            Lstselectable.Enabled = True
            Lstautolabel.Enabled = True


            '设置排序按钮状态
             Call Lstlayers_Click
  Else

  MsgBox "该层文件已被打开，不允许再次打开！！", vbOKOnly + vbExclamation, "提示"
  End If



End Sub

Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmddisplay_Click()

  
frmdisPlayOptions.Show

End Sub

Private Sub cmddown_Click()
'改变图层顺序：将图层位置后移
Dim intSelIndex As Integer
Dim blnTemp As Boolean



intSelIndex = Lstlayers.ListIndex
Lstlayers.AddItem Lstlayers.List(intSelIndex), intSelIndex + 2
Lstlayers.RemoveItem intSelIndex
Lstlayers.ListIndex = intSelIndex + 1


m_BlnIsMouseClick = False
blnTemp = lstvisible.Selected(intSelIndex)
lstvisible.Selected(intSelIndex) = lstvisible.Selected(intSelIndex + 1)
lstvisible.Selected(intSelIndex + 1) = blnTemp

blnTemp = lsteditable.Selected(intSelIndex)
lsteditable.Selected(intSelIndex) = lsteditable.Selected(intSelIndex + 1)
lsteditable.Selected(intSelIndex + 1) = blnTemp

blnTemp = Lstselectable.Selected(intSelIndex)
Lstselectable.Selected(intSelIndex) = Lstselectable.Selected(intSelIndex + 1)
Lstselectable.Selected(intSelIndex + 1) = blnTemp

blnTemp = Lstautolabel.Selected(intSelIndex)
Lstautolabel.Selected(intSelIndex) = Lstautolabel.Selected(intSelIndex + 1)
Lstautolabel.Selected(intSelIndex + 1) = blnTemp

m_BlnIsMouseClick = True
'调用列表框的Scroll事件过程以保证个列表框可见项目的同步
Call Lstlayers_Scroll
End Sub

Private Sub cmdlabel_Click()
frmLabelOptions.Show
End Sub

Private Sub cmdOk_Click()
 Dim intinsertionlayerindex As Integer
    Dim strLayerName As String
    Dim intLayerpos As Integer
    Dim lyrinew As New MapXLib.LayerInfo
    Dim ds As MapXLib.Dataset
    Dim i As Integer
    
    
        '向地图集中添加用户加载的新层
       For i = 1 To m_intAddedLyrCount
      lyrinew.Type = miLayerInfoTypeTab
      lyrinew.AddParameter "filespec", m_audtAddedLyrInfo(i).filepath
      g_Map.Layers.Add lyrinew, 1
      Next i
    
    
    '从地图集中删除被用户卸载的层
    For i = 1 To m_intRemovedLyrCount
      g_Map.Layers.Remove m_audtRemovedLyrInfo(i).layername
    Next i
    
    
    '设置层序
    For i = 1 To Lstlayers.ListCount
      strLayerName = Lstlayers.List(i - 1)
      intLayerpos = FindLayerInMap(strLayerName, g_Map)
      g_Map.Layers.Move intLayerpos, i
      Next i
     
     
     '更新显示属性被修改国的层
     For i = 1 To m_intDispModifiedLyrCount
       strLayerName = g_audtLPModifiedLyr(i).layername
       If FindLayerInMap(strLayerName, g_Map) > 0 Then '确保该层未被删除
            If g_audtLPModifiedLyr(i).Overlap Then
              g_Map.Layers(strLayerName).OverrideStyle = True
              Set g_Map.larers(strLayerName).Style = g_audtDispModifiedLyr(i).NewStyle
            End If
            If g_audtDispModifiedLyr(i).ZoomLayer Then
            g_Map.Layers(strLayerName).ZoomLayer = True
            g_Map.Layers(strLayerName).ZoomMin = g_audtDispModifiedLyr(i).ZoomMin
         
            g_Map.Layers(strLayerName).ZoomMax = g_audtDispModifiedLyr(i).ZoomMax
            End If
         
            g_Map.Layers(strLayerName).ShowLineDirection = g_audtDispModifiedLyr(i).ShowLineDirection
            g_Map.Layers(strLayerName).ShowNodes = g_audtDispModifiedLyr(i).ShowNodes
            g_Map.Layers(strLayerName).ShowCentroids = g_audtDispModifiedLyr(i).ShouwCentroids
         End If
    Next i
        
        '更新标注属性被修改过的层
         For i = 1 To m_intDispModifiedLyrCount
             strLayerName = g_audtLPModifiedLyr(i).layername
             If FindLayerInMap(strLayerName, g_Map) > 0 Then '确保该层未被删除
                 
                
                 If g_audtLPModifiedLyr(i).DataFieldName <> "" Then
                 Set ds = g_Map.DataSets.Add(miDataSetLayer, g_Map.Layers(strLayerName))
                 Set g_Map.Layers(strLayerName).LabelProperties.DataField = ds.Fields(g_audtLPModifiedLyr(i).DataFieldName)
                 End If
                  
                  
                 g_Map.Layers.Item(strLayerName).LabelProperties.Labelzoom = g_audtLPModifiedLyr(i).LabelMax
                 g_Map.Layers.Item(strLayerName).LabelProperties.Duplicate = g_audtLPModifiedLyr(i).Duplicate
                 
                 
                 If g_audtLPModifiedLyr(i).Labelzoom Then
                 g_Map.Layers.Item(strLayerName).LabelProperties.LabelMax = True
                 g_Map.Layers.Item(strLayerName).LabelProperties.LabelZoomMin = g_audtLPModifiedLyr(i).LabelZoomMin
                 g_Map.Layers.Item(strLayerName).LabelProperties.LabelZoomMax = g_audtLPModifiedLyr(i).LabelMax
                 
                 Else
                
                 g_Map.Layers.Item(strLayerName).LabelProperties.Labelzoom = False
                 
                 
                 End If
             g_Map.Layers(strLayerName).LabelProperties.LineType = g_audtLPModifiedLyr(i).LineType
             g_Map.Layers(strLayerName).LabelProperties.Offset = g_audtLPModifiedLyr(i).Offset
             g_Map.Layers(strLayerName).LabelProperties.Overlap = g_audtLPModifiedLyr(i).Overlap
             g_Map.Layers(strLayerName).LabelProperties.Parallel = g_audtLPModifiedLyr(i).Parallel '系统没有
             g_Map.Layers(strLayerName).LabelProperties.PartialSegments = g_audtLPModifiedLyr(i).PartialSegments
             g_Map.Layers(strLayerName).LabelProperties.Position = g_audtLPModifiedLyr(i).Position
             g_Map.Layers(strLayerName).LabelProperties.Visible = g_audtLPModifiedLyr(i).Visible
           End If
           Next i
           
           '根据用户设置各层状态，并记录可编辑图层位置
           intinsertionlayerindex = 0
           For i = 1 To Lstlayers.ListCount
           g_Map.Layers(i).Visible = lstvisible.Selected(i - 1)
           g_Map.Layers(i).Editable = lsteditable.Selected(i - 1)
           g_Map.Layers(i).Selectable = Lstselectable.Selected(i - 1)
           g_Map.Layers(i).AutoLabel = Lstautolabel.Selected(i - 1)
           
           
           
           If lsteditable.Selected(i - 1) Then
           intinsertionlayerindex = i
           End If
           Next i
           
           
           '若存在可编辑图层，将其置为insertionlayer
           If intinsertionlayerindex > 0 Then
           Set g_Map.Layers.InsertionLayer = g_Map.Layers(intinsertionlayerindex)
           End If
           Unload Me
           End Sub

Private Sub cmdremovelayer_Click()
'从地图集中删除图层
Dim intSelIndex As Integer
Dim strLayerName As String
Dim strtabpath As String
Dim blnremovednewtab As Boolean
Dim i As Integer

'获取待删除层名和文件路径
intSelIndex = Lstlayers.ListIndex
strLayerName = Lstlayers.List(intSelIndex)


'待添加图层为进入层控制后被添加的图层，从添加图层记录m_audtaddedlyrinfo中去除该层的记录

blnremovednewtab = False


For i = 1 To m_intAddedLyrCount
       If strLayerName = m_audtAddedLyrInfo(i).layername Then
           updateaddedlayersrecord strLayerName, True, i
           blnremovednewtab = True
           Exit For
       End If
      
      
Next i



'若待删除图层为地图集中原有文件，记录该待删除图层至m_audtremovedlyrinfo
If Not blnremovednewtab Then
    updateremovedlayersrecord strLayerName, False
End If
'更新个列表框
           'Lstlayers.AddItem strlayername, 0
            lstvisible.RemoveItem intSelIndex
            lsteditable.RemoveItem intSelIndex
            Lstselectable.RemoveItem intSelIndex
            Lstautolabel.RemoveItem intSelIndex
            Lstlayers.RemoveItem intSelIndex
If Lstlayers.ListCount = 0 Then


            
            
            Lstlayers.Enabled = False
            lstvisible.Enabled = False
            lsteditable.Enabled = False
            Lstselectable.Enabled = False
            Lstautolabel.Enabled = False
End If

'设置排序按扭状态
Call Lstlayers_Click

SetDipLabelCmdState

End Sub

Private Sub cmdup_Click()
'改变图层顺序：将图层位置前移
Dim intSelIndex As Integer
Dim blnTemp As Boolean



intSelIndex = Lstlayers.ListIndex
Lstlayers.AddItem Lstlayers.List(intSelIndex), intSelIndex - 1
Lstlayers.RemoveItem intSelIndex + 1
Lstlayers.ListIndex = intSelIndex - 1


'交换列表框相邻两项选中状态时，会激发ItemCheck事件，从而影响其他列表框相应项的状态，为此设置标志，只有m_blnismouseclick为ture时，才对ItemCheck事件进行处理
m_BlnIsMouseClick = False
blnTemp = lstvisible.Selected(intSelIndex)
lstvisible.Selected(intSelIndex) = lstvisible.Selected(intSelIndex - 1)
lstvisible.Selected(intSelIndex - 1) = blnTemp

blnTemp = lsteditable.Selected(intSelIndex)
lsteditable.Selected(intSelIndex) = lsteditable.Selected(intSelIndex - 1)
lsteditable.Selected(intSelIndex - 1) = blnTemp

blnTemp = Lstselectable.Selected(intSelIndex)
Lstselectable.Selected(intSelIndex) = Lstselectable.Selected(intSelIndex - 1)
Lstselectable.Selected(intSelIndex - 1) = blnTemp

blnTemp = Lstautolabel.Selected(intSelIndex)
Lstautolabel.Selected(intSelIndex) = Lstautolabel.Selected(intSelIndex - 1)
Lstautolabel.Selected(intSelIndex - 1) = blnTemp

m_BlnIsMouseClick = True
'调用列表框的Scroll事件过程以保证个列表框可见项目的同步
Call Lstlayers_Scroll
End Sub

Private Sub Form_Load()
      Dim LngWndStyle As Long
      Dim strLayerName As String
      Dim i As Integer
      
      '在进入层控制前禁止地图的自动更新
      g_Map.AutoRedraw = False
      
      m_BlnIsFormLoaded = False
      '作业
   
    
     If Lstautolabel.ListIndex = -1 And lsteditable.ListIndex = -1 And Lstselectable.ListIndex = -1 And lstvisible.ListIndex = -1 Then
          cmddisplay.Enabled = False
          cmdlabel.Enabled = False
    Else
     cmddisplay.Enabled = True
    cmdlabel.Enabled = True
    End If
'去除各列表框边界
LngWndStyle = GetWindowLong(Lstlayers.hwnd, GWL_STYLE)
'lngwndstyle
LngWndStyle = LngWndStyle And Not WS_BORDER
SetWindowLong Lstlayers.hwnd, GWL_STYLE, LngWndStyle

LngWndStyle = GetWindowLong(lstvisible.hwnd, GWL_STYLE)
LngWndStyle = LngWndStyle And Not WS_BORDER
SetWindowLong lstvisible.hwnd, GWL_STYLE, LngWndStyle

LngWndStyle = GetWindowLong(lsteditable.hwnd, GWL_STYLE)
LngWndStyle = LngWndStyle And Not WS_BORDER
SetWindowLong lsteditable.hwnd, GWL_STYLE, LngWndStyle


LngWndStyle = GetWindowLong(Lstselectable.hwnd, GWL_STYLE)
LngWndStyle = LngWndStyle And Not WS_BORDER
SetWindowLong Lstselectable.hwnd, GWL_STYLE, LngWndStyle


LngWndStyle = GetWindowLong(Lstautolabel.hwnd, GWL_STYLE)
LngWndStyle = LngWndStyle And Not WS_BORDER
SetWindowLong Lstautolabel.hwnd, GWL_STYLE, LngWndStyle


'清空列表
Lstlayers.Clear
lstvisible.Clear
lsteditable.Clear
Lstselectable.Clear