frm_lyr.frm

vb+mo而次开发实现鹰眼功能

End Sub

Sub Lyr_see_fresh()
Dim i, lyr_cnt3, lyr_loc As Integer
Dim lyr As MapLayer
i = frm_main.Map1.Layers.Count

For lyr_cnt3 = 0 To i - 1
  
  If chk_see(lyr_cnt3).Visible = False Then
    
    chk_see(lyr_cnt3).Value = vbChecked
    chk_see(lyr_cnt3).Visible = True
  End If
  
Next

For lyr_loc = lyr_cnt3 To 9 '因为只设置了九个静态控件
  If chk_see(lyr_loc).Visible = True Then
     chk_see(lyr_loc).Visible = False
     
  End If
  
Next



End Sub

 

 

Private Sub Cmd_cancle_Click()

frm_lyr.Hide

End Sub

Private Sub Cmd_ok_Click()
Dim i, lyr_loc1 As Integer
Dim lyr As MapLayer
i = frm_main.Map1.Layers.Count

For lyr_loc1 = 0 To i - 1
  If chk_see(lyr_loc1).Value = 1 Then
    Set lyr = New MapLayer
     Set lyr = frm_main.Map1.Layers.Item(lyr_loc1)
     lyr.Visible = True
     frm_main.Map1.Refresh
       
  ElseIf chk_see(lyr_loc1).Value = 0 Then
     Set lyr = New MapLayer
     Set lyr = frm_main.Map1.Layers.Item(lyr_loc1)
     lyr.Visible = False
     frm_main.Map1.Refresh
     
  End If
  
Next
'上是设置图层的可见性

frm_lyr.Hide
End Sub

 

Private Sub Command1_Click()
frm_see.Show

End Sub

Private Sub Form_Activate()
 
Dim i As Integer


i = frm_main.Map1.Layers.Count

If i = 0 Then
   Lyr_see_fresh
   Exit Sub
End If

   
If i <> 0 Then
   Lyr_lst_fresh
   Lyr_see_fresh
End If

If lyr_lst.ListIndex = -1 Then
   Lyr_remove.Enabled = False
   Lyr_up.Enabled = False
   Lyr_down.Enabled = False
   
End If
'确保没有焦点时 删除图层按钮为不可用状态



End Sub

Private Sub Form_Load()

  Lyr_remove.Enabled = False
  Lyr_up.Enabled = False
  Lyr_down.Enabled = False
  
  'Unload frm_see
  'Unload frm_Identify
  '还存在错误 主要是窗体自动关闭
  
  
End Sub

 

 

Private Sub lyr_add_Click()
On Error GoTo cancleOne

Dim lyr As MapLayer
Dim dc As New DataConnection
Dim str, strSub1, strSub2 As String
Dim i, str_len As Integer
   CommonDialog1.ShowOpen
   str = CommonDialog1.FileName
   str_len = Len(str)
   i = InStrRev(str, "\")
   strSub1 = Left$(str, i - 1)
   strSub2 = Mid$(str, i + 1, str_len - i - 4)
   
   Set lyr = New MapLayer
   dc.Database = strSub1
   If Not dc.Connect Then
     MsgBox ("未能成功连接")
   End If
   lyr.GeoDataset = dc.FindGeoDataset(strSub2)
   frm_main.Map1.Layers.Add lyr
   frm_see.Map1.Layers.Add lyr
   
'此处增加图层跟主窗体的增加图层同样存在错误 需调整

Lyr_lst_fresh
Lyr_see_fresh

If lyr_lst.ListIndex = -1 Then
   Lyr_remove.Enabled = False
   Lyr_up.Enabled = False
   Lyr_down.Enabled = False
   
   
End If

cancleOne:
 
Exit Sub
 
 
End Sub

Private Sub Lyr_down_Click()
Dim i, Bol  As Integer
i = lyr_lst.ListIndex


Dim lyrs As MapObjects2.Layers
Set lyrs = frm_main.Map1.Layers
lyrs.MoveTo lyr_lst.ListIndex, lyr_lst.ListIndex + 1

Lyr_lst_fresh
 
Bol = chk_see(i + 1).Value
chk_see(i + 1).Value = chk_see(i).Value
chk_see(i).Value = Bol

'实现图层顺序改变以后的 原来可见性的传递


If lyr_lst.ListIndex = -1 Then
   
   Lyr_remove.Enabled = False
   Lyr_up.Enabled = False
   Lyr_down.Enabled = False
     
End If

frm_see.Map1.Refresh
frm_main.Map1.Refresh


End Sub

Private Sub lyr_lst_Click()

If lyr_lst.ListIndex <> -1 Then

  Lyr_remove.Enabled = True
   Lyr_up.Enabled = True
   Lyr_down.Enabled = True
         
End If

'If (lyr_lst.ListIndex <> -1 And lyr_lst.ListIndex <> 0) Then
If lyr_lst.ListIndex = 0 Then
   Lyr_up.Enabled = False
End If

If lyr_lst.ListIndex = frm_main.Map1.Layers.Count - 1 Then
   Lyr_down.Enabled = False
End If

If frm_main.Map1.Layers.Count = 1 Then
   Lyr_up.Enabled = False
   Lyr_down.Enabled = False
End If

End Sub


Private Sub lyr_lst_DblClick()
Dim lyrs As MapObjects2.Layers
Set lyrs = frm_main.Map1.Layers

lyrs.MoveToTop (lyr_lst.ListIndex)
frm_main.Map1.Refresh
frm_see.Map1.Refresh


Lyr_lst_fresh
Lyr_see_fresh

End Sub



Private Sub Lyr_remove_Click()
Dim i, ii(1 To 20), cnt  As Integer
Dim lyr_cnt As Integer

lyr_cnt = frm_main.Map1.Layers.Count
i = lyr_lst.ListIndex
 

For cnt = 1 To i
ii(cnt) = chk_see(cnt - 1).Value
Next

 
For cnt = i + 1 To frm_main.Map1.Layers.Count - 1
   
   ii(cnt) = chk_see(i + 1).Value
   i = i + 1
    
Next

frm_main.Map1.Layers.Remove (lyr_lst.ListIndex)
frm_main.Map1.Refresh
frm_see.Map1.Refresh


For cnt = 1 To frm_main.Map1.Layers.Count
    chk_see(cnt - 1) = ii(cnt)
    
Next


chk_see(lyr_cnt - 1).Visible = False
chk_see(lyr_cnt - 1).Value = 1

Lyr_lst_fresh
 
If lyr_lst.ListIndex = -1 Then
   
   Lyr_remove.Enabled = False
   Lyr_up.Enabled = False
   Lyr_down.Enabled = False
     
End If

'Call frm_main.refreshScale
 

 

  

End Sub


 
Private Sub Lyr_up_Click()
 

Dim i, Bol  As Integer
i = lyr_lst.ListIndex


Dim lyrs As MapObjects2.Layers
Set lyrs = frm_main.Map1.Layers
lyrs.MoveTo lyr_lst.ListIndex, lyr_lst.ListIndex - 1

Lyr_lst_fresh
 
Bol = chk_see(i).Value
chk_see(i).Value = chk_see(i - 1).Value
chk_see(i - 1).Value = Bol

'实现图层顺序改变以后的 原来可见性的传递


If lyr_lst.ListIndex = -1 Then
   
   Lyr_remove.Enabled = False
   Lyr_up.Enabled = False
   Lyr_down.Enabled = False
     
End If

frm_main.Map1.Refresh
frm_see.Map1.Refresh


End Sub