frmoverview.frm

VB开发的基于mo控件的例子

VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Begin VB.Form frmOverview 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "Overview"
   ClientHeight    =   2505
   ClientLeft      =   45
   ClientTop       =   285
   ClientWidth     =   2505
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2505
   ScaleWidth      =   2505
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin MapObjects2.Map mapOverview 
      Height          =   2400
      Left            =   60
      TabIndex        =   0
      Top             =   60
      Width           =   2400
      _Version        =   131072
      _ExtentX        =   4233
      _ExtentY        =   4233
      _StockProps     =   225
      BackColor       =   16777215
      BorderStyle     =   1
      Appearance      =   1
      ScrollBars      =   0   'False
      Contents        =   "frmOverview.frx":0000
   End
End
Attribute VB_Name = "frmOverview"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'
'  Module Name:  frmOverview
'
'  Description:  Overview form
'
'     Requires:  (nothing)
'
'      Methods:  AddLayer - adds a layer to show on the overview map
'                AddMap - adds a map to be updated when the extent is changed
'                SetExtent - sets the currently displayed extent
'                SetFullExtent - sets the full extent for the overview map
'                StayOnTop - sets the "always on top" mode for this form
'
'      History:  Peter Girard, ESRI - 9/99 - original coding
'
'=============================================================================

Option Explicit

' -- window position and state

Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, _
    ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, _
    ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2

Dim mMaps As New Collection
Dim mExtent As MapObjects2.Rectangle

Private Sub Form_Load()

StayOnTop True

End Sub

Private Sub mapOverview_BeforeTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)

Dim lSym As MapObjects2.Symbol, l As MapObjects2.Line
Dim pts As MapObjects2.Points, p As MapObjects2.Point

' -- draw the extent as a thick red line

If Not mExtent Is Nothing Then
  Set lSym = New MapObjects2.Symbol
  lSym.SymbolType = moLineSymbol
  lSym.Color = moRed
  lSym.Size = 3

  Set l = New MapObjects2.Line
  Set pts = New MapObjects2.Points
  Set p = New MapObjects2.Point
  p.X = mExtent.Left
  p.Y = mExtent.Bottom
  pts.Add p
  Set p = New MapObjects2.Point
  p.X = mExtent.Left
  p.Y = mExtent.Top
  pts.Add p
  Set p = New MapObjects2.Point
  p.X = mExtent.Right
  p.Y = mExtent.Top
  pts.Add p
  Set p = New MapObjects2.Point
  p.X = mExtent.Right
  p.Y = mExtent.Bottom
  pts.Add p
  Set p = New MapObjects2.Point
  p.X = mExtent.Left
  p.Y = mExtent.Bottom
  pts.Add p
  l.Parts.Add pts
  
  mapOverview.DrawShape l, lSym
End If

End Sub

Private Sub mapOverview_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim e As MapObjects2.Rectangle

' -- let the user create a new extent with the left mouse button or begin
' -- dragging the current extent with the right

If Button = 1 Then
  Set mExtent = mapOverview.TrackRectangle
  UpdateMaps
Else
  MoveExtent mapOverview.ToMapPoint(X, Y)
End If

End Sub

Private Sub mapOverview_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

' -- continue dragging the extent

If Button = 2 Then
  MoveExtent mapOverview.ToMapPoint(X, Y)
End If

End Sub

Private Sub mapOverview_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

' -- finish dragging the extent

If Button = 2 Then
  UpdateMaps
End If

End Sub

Private Sub MoveExtent(p As MapObjects2.Point)

Dim c As MapObjects2.Point

' -- shift the extent to a new center point and draw it

Set c = mExtent.Center
mExtent.Offset p.X - c.X, p.Y - c.Y
mapOverview.TrackingLayer.Refresh True

End Sub

Private Sub UpdateMaps()

Dim m As MapObjects2.Map

' -- set the new extent on each of the maps

For Each m In mMaps
  m.Extent = mExtent
Next m

End Sub

Public Sub AddLayer(ml As MapObjects2.MapLayer)

' -- add a layer to show on the overview map

mapOverview.Layers.Add ml

End Sub

Public Sub AddMap(m As MapObjects2.Map)

' -- add a map to update when the extent is changed

mMaps.Add m

End Sub

Public Sub SetExtent(e As MapObjects2.Rectangle)

' -- receive a new extent from an external source

Set mExtent = e
If Me.Visible Then
  mapOverview.TrackingLayer.Refresh True
End If

End Sub

Public Sub SetFullExtent(e As MapObjects2.Rectangle)

' -- set the full extent for the overview map

mapOverview.FullExtent = e
mapOverview.Extent = mapOverview.FullExtent

End Sub
 
Public Sub StayOnTop(onTop As Boolean)

Dim fLeft As Long, fTop As Long, fWidth As Long, fHeight As Long
Dim fState As Long

' -- set the "always on top" mode for this form

fLeft = Me.Left / Screen.TwipsPerPixelX
fTop = Me.Top / Screen.TwipsPerPixelY
fWidth = Me.Width / Screen.TwipsPerPixelX
fHeight = Me.Height / Screen.TwipsPerPixelY

If onTop Then
  fState = HWND_TOPMOST
Else
  fState = HWND_NOTOPMOST
End If

SetWindowPos Me.hWnd, fState, fLeft, fTop, fWidth, fHeight, 0

End Sub