鷹眼圖在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