eagleeye.txt

该程序使用VB与MO实现地图的鹰眼功能的基本代码

鹰眼图在VB+MapObjects2.3中的实现(上)

Map1为主视图，Map2为鹰眼图（放置全图显示的图层，并且不会改变比例），以下俩段代码可以实现鹰眼睛图的显示，但是要想在Map2中实现拖动红色的矩形框（Map1的当前显示范围）来移动Map1中的显示范围，则需要用到gdi.dll,user32。dll的知识，将在后面作详细介绍该功能。

而红色矩形框的作用：在主视图（Map1）中进行放大，缩小的变换操作后，在鹰眼图（Map2）中的红色矩形框则标示主视图（Map1）的当前范围。

Private Sub Map1_AfterLayerDraw(ByVal index As Integer, ByVal canceled As Boolean, ByVal hdc As Stdole.OLE_HANDLE)
  If index = 0 Then
     '在主视图的首图层绘制后刷新Map2来更新红线范围
      Map2.TrackingLayer.Refresh True
  End If
End Sub

Private Sub Map2_AfterTrackingLayerDraw(ByVal hdc As Stdole.OLE_HANDLE)
  ' 在Map2中绘制Map1的当前显示范围
  Dim sym As New Symbol
  sym.OutlineColor = moRed
  sym.Style = moTransparentFill
  Map2.DrawShape Map1.Extent, sym
End Sub

如果你看了该系列的下，则可以使用下面代码，DragDLL1是定义一个类，该类在系列下有介绍，定义位置放在该窗体代码的顶端

Dim DragDLL1 as  New DragDLL
Private Sub Map2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  '将Map2中的窗体坐标转化为地图坐标(鹰眼图)
  Dim p As MapObjects2.Point
  Set p = Map2.ToMapPoint(X, Y)
  
  '判断点p是否在Map2的红线框架内即Map1的当前显示范围(鹰眼图)
  If Map1.Extent.IsPointIn(p) Then
    Set DragDLL1 = New DragDLL1

    DragDLL1 .DragStart Map1.Extent, Map2, X, Y
  End If
End Sub

Private Sub Map2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Not DragDLL1 Is Nothing Then
    DragDLL1 .DragMove X, Y
  End If
End Sub

Private Sub Map2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Not DragDLL1 Is Nothing Then
    Map1.Extent = DragDLL1 .DragFinish(X, Y)
    Set DragDLL1 = Nothing
  End If
End Sub

 鹰眼图在VB+MapObjects2.3中的实现(下)

下面是类模块的代码，类模块名称为DragDLL.CLs

将上下结合使用就能实现完满的鹰眼图

'Map2指鹰眼窗口

' WinAPI函数定义

'hdc 设备,hwnd 表示窗体,这里指Map2

'GetDC 获的设备

'ReleaseDC '释放设备

'GdiRectangle 绘制矩形窗体

'GdiRectangle 设置指定设备场景的绘图模式。这里指Map2

Private Declare Function GdiRectangle Lib "gdi32" Alias "Rectangle" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long

'设置绘制的样式为反色，反色呈透明状,R2_NOTXORPEN是nDrawMode的一种方式

Private Const R2_NOTXORPEN = 10 

'地图对象的定义

Dim map_map As MapObjects2.Map

'下面变量的作用是动态标示红色矩形的位置

Dim map_hDC As Long         '绘制的设备句柄

Dim map_hWnd As Long        '绘制的窗体句柄

Dim map_xMin As Integer, map_yMin As Integer  ' 动态标示说绘制矩形坐标

Dim map_xMax As Integer, map_yMax As Integer  ' 动态标示说绘制矩形坐标

Dim map_xPrev As Integer       ' 记录点击位置

Dim map_yPrev As Integer       ' 记录点击位置

Dim xNext As Integer         ' 记录后一点击Ｘ位置

Dim yNext As Integer         ' 记录后一点击Ｙ位置

Function DragFinish(x As Single, y As Single) As MapObjects2.Rectangle

  GdiRectangle map_hDC, map_xMin, map_yMin, map_xMax, map_yMax

  ReleaseDC map_hWnd, map_hDC

  

  '返回说绘制的矩形

  Dim r As New MapObjects2.Rectangle

  PixelsRectToMap map_xMin, map_yMin, map_xMax, map_yMax, r

  Set DragFinish = r

End Function

Sub DragMove(x As Single, y As Single)

' 记录所点击的后一位置并转化为窗体坐标

  xNext = map_map.Parent.ScaleX(x, vbTwips, vbPixels)

  yNext = map_map.Parent.ScaleY(y, vbTwips, vbPixels)

    

   

  GdiRectangle map_hDC, map_xMin, map_yMin, map_xMax, map_yMax

  

  '找出拖动后鼠标的位置，并画出矩形

  map_xMin = map_xMin + (xNext - map_xPrev)

  map_xMax = map_xMax + (xNext - map_xPrev)

  map_yMin = map_yMin + (yNext - map_yPrev)

  map_yMax = map_yMax + (yNext - map_yPrev)

  

  GdiRectangle map_hDC, map_xMin, map_yMin, map_xMax, map_yMax

  

  '记录所点击的前一位置并转化为窗体坐标

  map_xPrev = xNext

  map_yPrev = yNext

End Sub

Sub DragStart(rect As MapObjects2.Rectangle, Map As MapObjects2.Map, x As Single, y As Single)

  Set map_map = Map

  ' 初始化 hwnd 和 hdc 变量

  map_hWnd = map_map.hwnd '获得Map2的窗体的句柄

  map_hDC = GetDC(map_hWnd)

  SetROP2 map_hDC, R2_NOTXORPEN    '在拖动红色矩形框色，Map2会重新绘制

  '将Map中的坐标转换为窗体坐标,目的是为了绘制矩形窗体

  MapRectToPixels rect, map_xMin, map_yMin, map_xMax, map_yMax

  

  ' 绘制矩形窗体

  GdiRectangle map_hDC, map_xMin, map_yMin, map_xMax, map_yMax

  

  ' 记录所点击的前一位置并转化为窗体坐标

  map_xPrev = map_map.Parent.ScaleX(x, vbTwips, vbPixels)

  map_yPrev = map_map.Parent.ScaleY(y, vbTwips, vbPixels)

End Sub

'将Map中的坐标转换为窗体坐标

Private Sub MapRectToPixels(r As MapObjects2.Rectangle, xMin As Integer, yMin As Integer, xMax As Integer, yMax As Integer)

  Dim p As New MapObjects2.Point

  Dim xc As Single, yc As Single

  

  p.x = r.Left

  p.y = r.Top

  map_map.FromMapPoint p, xc, yc

  

  ' 转化为像素（左上角坐标）

  xMin = map_map.Parent.ScaleX(xc, vbTwips, vbPixels)

  yMin = map_map.Parent.ScaleY(yc, vbTwips, vbPixels)

  p.x = r.Right

  p.y = r.Bottom

  map_map.FromMapPoint p, xc, yc

  

  ' 转化为像素（右下角坐标）

  xMax = map_map.Parent.ScaleX(xc, vbTwips, vbPixels)

  yMax = map_map.Parent.ScaleY(yc, vbTwips, vbPixels)

End Sub

Sub PixelsRectToMap(xMin As Integer, yMin As Integer, xMax As Integer, yMax As Integer, r As MapObjects2.Rectangle)

  Dim xc As Single, yc As Single

  

  ' 将左上角窗体坐标转换为地图坐标

  xc = map_map.Parent.ScaleX(xMin, vbPixels, vbTwips)

  yc = map_map.Parent.ScaleY(yMin, vbPixels, vbTwips)

  

  Set p = map_map.ToMapPoint(xc, yc)

  r.Left = p.x

  r.Top = p.y

  ' 将右下角窗体坐标转换为地图坐标

  xc = map_map.Parent.ScaleX(xMax, vbPixels, vbTwips)

  yc = map_map.Parent.ScaleY(yMax, vbPixels, vbTwips)

  Set p = map_map.ToMapPoint(xc, yc)

  r.Right = p.x

  r.Bottom = p.y

End Sub