frm_main.frm

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

Private Sub Allsee_Click()
frm_see.Show

End Sub

Private Sub Form_Activate()

If Map1.Layers.Count = 0 Then

    stusBar1.Panels(1).Text = "No Layer......"
    stusBar1.Panels(2).Text = " "
    stusBar1.Panels(3).Text = " "
    
    
End If

End Sub

Private Sub Form_Load()

Map1.Left = 0
Map1.Top = Toolbar1.Height

Map1.Width = frm_main.Width
Map1.Height = frm_main.Height - Toolbar1.Height

stusBar1.Panels(1).Width = frm_main.Width / 4
stusBar1.Panels(2).Width = frm_main.Width / 4
stusBar1.Panels(3).Width = frm_main.Width / 4
 

zbX1 = 200
zbX2 = Map1.Width
zbY1 = 200
zbY2 = Int(Map1.Height / 2) + 1000
Xmid = Map1.Extent.Left + Int(Map1.Extent.Width / 2)
Ymid = Map1.Extent.Top - Int(Map1.Extent.Height / 2)

sclBar1.Visible = False


'各个控件的加载顺序不一样 设置的各个控件的属性也不一样
'先加map1控件 和最后加map1控件 的 上述代码有区别

End Sub

Private Sub Form_Resize()
 
Map1.Width = frm_main.Width
Map1.Height = frm_main.Height
Map1.Height = frm_main.Height - Toolbar1.Height - stusBar1.Height

stusBar1.Panels(1).Width = frm_main.Width / 4
stusBar1.Panels(2).Width = frm_main.Width / 4
stusBar1.Panels(3).Width = frm_main.Width / 4
 

End Sub

Private Sub Form_Unload(Cancel As Integer)

'Unload frm_Identify
'Unload frm_lyr
'Unload frm_see
'存在窗体自动关闭的错误


End Sub

Private Sub help_about_Click()
frm_about.Show
End Sub



Private Sub Map1_AfterLayerDraw(ByVal index As Integer, ByVal canceled As Boolean, ByVal hdc As stdole.OLE_HANDLE)

If index = 0 Then
   frm_see.Map1.TrackingLayer.Refresh True
End If
'使与鸟瞰图的图层联系在一起

Call refreshScale

'If gg = 111 Then

'Map1.DrawShape recSelection, sym_Selection

'End If
'这里主要是未能实现对所画的东西 进行清除去 功能有待完善

End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

Dim p As MapObjects2.Point
Set p = Map1.ToMapPoint(x, y)

If Map1.MousePointer = moZoomIn Then
   Map1.Extent = Map1.TrackRectangle
   ZoomIn
   frm_see.Map1.Refresh
ElseIf Map1.MousePointer = moZoomOut Then
   ZoomOut
   frm_see.Map1.Refresh
ElseIf Map1.MousePointer = moPan Then
   ZoomPan
   frm_see.Map1.Refresh
ElseIf Map1.MousePointer = moIdentify Then
   If p.x < Xmid Then
      frm_Identify.Left = zbX2
   Else
      frm_Identify.Left = zbX1
   End If
   
   If p.y < Ymid Then
      frm_Identify.Top = zbY2
   Else
      frm_Identify.Top = zbY1
   End If
   
   Call frm_Identify.Identify(x, y)
   frm_Identify.ZOrder 0
   
End If

Map1.Refresh

End Sub

Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

Dim pt As MapObjects2.Point
Set pt = Map1.ToMapPoint(x, y)

If Map1.Layers.Count <> 0 Then

   stusBar1.Panels(2).Text = "X=" & Format(pt.x, "0.000000")
   stusBar1.Panels(3).Text = "Y=" & Format(pt.y, "0.000000")

End If

End Sub

Private Sub open_Click()
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)
Map1.Layers.Add lyr
frm_see.Map1.Layers.Add lyr
   
Toolbar1.Buttons(3).Value = tbrUnpressed
Toolbar1.Buttons(5).Value = tbrUnpressed
Toolbar1.Buttons(6).Value = tbrUnpressed
Toolbar1.Buttons(7).Value = tbrUnpressed
Toolbar1.Buttons(8).Value = tbrUnpressed

End Sub

Private Sub query_point_Click()
   Map1.MousePointer = moIdentify
   Toolbar1.Buttons(12).Value = tbrUnpressed
End Sub

Private Sub query_sql_Click()
frm_sql.Show

End Sub

Private Sub tool_big_Click()
Map1.MousePointer = moZoomIn
End Sub

Private Sub tool_globle_Click()
  Map1.MousePointer = moArrow
  Globle
End Sub

Private Sub tool_lyr_show_Click()
   Toolbar1.Buttons(5).Value = tbrUnpressed
   Toolbar1.Buttons(6).Value = tbrUnpressed
   Toolbar1.Buttons(7).Value = tbrUnpressed
   Toolbar1.Buttons(8).Value = tbrUnpressed
   Toolbar1.Buttons(10).Value = tbrUnpressed
   
   If frm_lyr.Width <= frm_main.Width Then
      frm_lyr.Left = frm_main.Left + (frm_main.Width - frm_lyr.Width) / 2
   Else
      frm_lyr.Left = frm_main.Left
   End If
   
   If frm_lyr.Height <= frm_main.Height Then
      frm_lyr.Top = (frm_main.Height - frm_lyr.Height) / 2 + frm_main.Top
   Else
      frm_lyr.Top = frm_main.Top
   End If
         
   '窗体显示在主窗体的中心位置
   frm_lyr.Show
End Sub

Private Sub tool_pan_Click()
 Map1.MousePointer = moPan
End Sub

Private Sub tool_small_Click()
Map1.MousePointer = moZoomOut
End Sub

Private Sub Timer1_Timer()

stusBar1.Panels(4).Text = Time

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
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

If Toolbar1.Buttons(3).Value Then
   CommonDialog1.ShowOpen
  'If CommonDialog1.CancelError = True Then
  'Exit Sub
  'End If
  
   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)
   Map1.Layers.Add lyr
   frm_see.Map1.Layers.Add lyr
   
   Toolbar1.Buttons(3).Value = tbrUnpressed
   Toolbar1.Buttons(5).Value = tbrUnpressed
   Toolbar1.Buttons(6).Value = tbrUnpressed
   Toolbar1.Buttons(7).Value = tbrUnpressed
   Toolbar1.Buttons(8).Value = tbrUnpressed
End If

If Toolbar1.Buttons(5).Value = tbrPressed Then
  Map1.MousePointer = moZoomIn
ElseIf Toolbar1.Buttons(6).Value = tbrPressed Then
  Map1.MousePointer = moZoomOut
ElseIf Toolbar1.Buttons(7).Value = tbrPressed Then
  Map1.MousePointer = moPan
ElseIf Toolbar1.Buttons(8).Value = tbrPressed Then
  Map1.MousePointer = moArrow
  Globle
End If

If Toolbar1.Buttons(2).Value Then
   Toolbar1.Buttons(2).Value = tbrUnpressed
   Toolbar1.Buttons(5).Value = tbrUnpressed
   Toolbar1.Buttons(6).Value = tbrUnpressed
   Toolbar1.Buttons(7).Value = tbrUnpressed
   Toolbar1.Buttons(8).Value = tbrUnpressed
End If

If Toolbar1.Buttons(10).Value Then
   Toolbar1.Buttons(5).Value = tbrUnpressed
   Toolbar1.Buttons(6).Value = tbrUnpressed
   Toolbar1.Buttons(7).Value = tbrUnpressed
   Toolbar1.Buttons(8).Value = tbrUnpressed
   Toolbar1.Buttons(10).Value = tbrUnpressed
   
   If frm_lyr.Width <= frm_main.Width Then
      frm_lyr.Left = frm_main.Left + (frm_main.Width - frm_lyr.Width) / 2
   Else
      frm_lyr.Left = frm_main.Left
   End If
   
   If frm_lyr.Height <= frm_main.Height Then
      frm_lyr.Top = (frm_main.Height - frm_lyr.Height) / 2 + frm_main.Top
   Else
      frm_lyr.Top = frm_main.Top
   End If
         
   '窗体显示在主窗体的中心位置
   frm_lyr.Show
   
End If

If Toolbar1.Buttons(12).Value Then
   
   Map1.MousePointer = moIdentify
   Toolbar1.Buttons(12).Value = tbrUnpressed
     
End If

cancleOne:
Toolbar1.Buttons(3).Value = 0
Exit Sub

End Sub


'遗留问题一： 如何返回通用对话框的取消按钮的参数值，存在着错误
'已经解决