frmoverview.vb

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

Option Strict Off
Option Explicit On
Friend Class frmOverview
	Inherits System.Windows.Forms.Form
	'
	'  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
	'
	'=============================================================================
	
	
	' -- window position and state
	
	Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer
	
	Private Const HWND_TOPMOST As Short = -1
	Private Const HWND_NOTOPMOST As Short = -2
	
	Dim mMaps As New Collection
	Dim mExtent As MapObjects2.Rectangle
	
	Private Sub frmOverview_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
		
		StayOnTop(True)
		
	End Sub
	
	Private Sub mapOverview_BeforeTrackingLayerDraw(ByVal eventSender As System.Object, ByVal eventArgs As AxMapObjects2._DMapEvents_BeforeTrackingLayerDrawEvent) Handles mapOverview.BeforeTrackingLayerDraw
		
		Dim lSym As MapObjects2.Symbol
		Dim l As MapObjects2.Line
		Dim pts As MapObjects2.Points
		Dim p As MapObjects2.Point
		
		' -- draw the extent as a thick red line
		
		If Not mExtent Is Nothing Then
			lSym = New MapObjects2.Symbol
			lSym.SymbolType = MapObjects2.SymbolTypeConstants.moLineSymbol
			lSym.Color = System.Convert.ToUInt32(MapObjects2.ColorConstants.moRed)
			lSym.Size = 3
			
			l = New MapObjects2.Line
			pts = New MapObjects2.Points
			p = New MapObjects2.Point
			p.X = mExtent.Left
			p.Y = mExtent.Bottom
			pts.Add(p)
			p = New MapObjects2.Point
			p.X = mExtent.Left
			p.Y = mExtent.Top
			pts.Add(p)
			p = New MapObjects2.Point
			p.X = mExtent.Right
			p.Y = mExtent.Top
			pts.Add(p)
			p = New MapObjects2.Point
			p.X = mExtent.Right
			p.Y = mExtent.Bottom
			pts.Add(p)
			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_MouseDownEvent(ByVal eventSender As System.Object, ByVal eventArgs As AxMapObjects2._DMapEvents_MouseDownEvent) Handles mapOverview.MouseDownEvent
		
		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 eventArgs.Button = 1 Then
			mExtent = mapOverview.TrackRectangle
			UpdateMaps()
		Else
			MoveExtent(mapOverview.ToMapPoint(eventArgs.X, eventArgs.Y))
		End If
		
	End Sub
	
	Private Sub mapOverview_MouseMoveEvent(ByVal eventSender As System.Object, ByVal eventArgs As AxMapObjects2._DMapEvents_MouseMoveEvent) Handles mapOverview.MouseMoveEvent
		
		' -- continue dragging the extent
		
		If eventArgs.Button = 2 Then
			MoveExtent(mapOverview.ToMapPoint(eventArgs.X, eventArgs.Y))
		End If
		
	End Sub
	
	Private Sub mapOverview_MouseUpEvent(ByVal eventSender As System.Object, ByVal eventArgs As AxMapObjects2._DMapEvents_MouseUpEvent) Handles mapOverview.MouseUpEvent
		
		' -- finish dragging the extent
		
		If eventArgs.Button = 2 Then
			UpdateMaps()
		End If
		
	End Sub
	
	Private Sub MoveExtent(ByRef p As MapObjects2.Point)
		
		Dim c As MapObjects2.Point
		
		' -- shift the extent to a new center point and draw it
		
		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 AxMapObjects2.AxMap
		
		' -- set the new extent on each of the maps
		
		For	Each m In mMaps
			m.Extent = mExtent
		Next m
		
	End Sub
	
	Public Sub AddLayer(ByRef ml As MapObjects2.MapLayer)
		
		' -- add a layer to show on the overview map
		
		mapOverview.Layers.Add(ml)
		
	End Sub
	
	Public Sub AddMap(ByRef m As AxMapObjects2.AxMap)
		
		' -- add a map to update when the extent is changed
		
		mMaps.Add(m)
		
	End Sub
	
	Public Sub SetExtent(ByRef e As MapObjects2.Rectangle)
		
		' -- receive a new extent from an external source
		
		mExtent = e
		If Me.Visible Then
			mapOverview.TrackingLayer.Refresh(True)
		End If
		
	End Sub
	
	Public Sub SetFullExtent(ByRef e As MapObjects2.Rectangle)
		
		' -- set the full extent for the overview map
		
		mapOverview.FullExtent = e
		mapOverview.Extent = mapOverview.FullExtent
		
	End Sub
	
	Public Sub StayOnTop(ByRef onTop As Boolean)
		
		Dim fWidth, fLeft, fTop, fHeight As Integer
		Dim fState As Integer
		
		' -- set the "always on top" mode for this form
		
		fLeft = VB6.PixelsToTwipsX(Me.Left) / VB6.TwipsPerPixelX
		fTop = VB6.PixelsToTwipsY(Me.Top) / VB6.TwipsPerPixelY
		fWidth = VB6.PixelsToTwipsX(Me.Width) / VB6.TwipsPerPixelX
		fHeight = VB6.PixelsToTwipsY(Me.Height) / VB6.TwipsPerPixelY
		
		If onTop Then
			fState = HWND_TOPMOST
		Else
			fState = HWND_NOTOPMOST
		End If
		
		SetWindowPos(Me.Handle.ToInt32, fState, fLeft, fTop, fWidth, fHeight, 0)
		
	End Sub
End Class