frmmain.frm

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

VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Begin VB.Form frmMain 
   Caption         =   "Overview and Magifier Example"
   ClientHeight    =   5925
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9420
   LinkTopic       =   "Form1"
   ScaleHeight     =   5925
   ScaleWidth      =   9420
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdMagnifier 
      Caption         =   "Magnifier"
      Height          =   375
      Left            =   7560
      TabIndex        =   3
      Top             =   120
      Width           =   975
   End
   Begin VB.CommandButton cmdOverview 
      Caption         =   "Overview"
      Height          =   375
      Left            =   6480
      TabIndex        =   2
      Top             =   120
      Width           =   975
   End
   Begin VB.CommandButton cmdFullView 
      Caption         =   "Full View"
      Height          =   375
      Left            =   480
      TabIndex        =   1
      Top             =   120
      Width           =   975
   End
   Begin MapObjects2.Map mapMain 
      Height          =   5175
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   8895
      _Version        =   131072
      _ExtentX        =   15690
      _ExtentY        =   9128
      _StockProps     =   225
      BackColor       =   16777215
      BorderStyle     =   1
      Appearance      =   1
      ScrollBars      =   0   'False
      Contents        =   "frmMain.frx":0000
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'
'  Module Name:  frmMain
'
'  Description:  Overview and Magnifier Demo interface
'
'     Requires:  frmMagnifier, frmOverview
'
'      Methods:  (none)
'
'      History:  Peter Girard, ESRI - 9/99 - original coding
'
'=============================================================================

Option Explicit

Dim mFullRedraw As Boolean

Private Sub cmdFullView_Click()

mapMain.Extent = mapMain.FullExtent

End Sub

Private Sub cmdMagnifier_Click()

Dim overVis As Boolean

' -- if the magnifier is starting and the overview is already on top of the
' -- main form, send the overview to the back so it does not appear in the
' -- magnifier's snapshot, start the magnifier, then restore the overview

If Not frmMagnifier.Visible Then
  overVis = frmOverview.Visible
  If overVis Then
    frmOverview.ZOrder vbSendToBack
    frmMain.Refresh
  End If
  frmMagnifier.Left = frmMain.Left + 600
  frmMagnifier.Top = frmMain.Top + 1200
  frmMagnifier.SetFormAndMap Me, mapMain
  frmMagnifier.Show
  If overVis Then
    frmOverview.StayOnTop True
  End If
End If

End Sub

Private Sub cmdOverview_Click()

If Not frmOverview.Visible Then
  frmOverview.Left = frmMain.Left + 600
  frmOverview.Top = frmMain.Top + 1200
  frmOverview.AddLayer mapMain.Layers("States")
  frmOverview.AddMap mapMain
  frmOverview.SetFullExtent mapMain.FullExtent
  frmOverview.Show
End If

End Sub

Private Sub Form_Load()

Dim dc As New MapObjects2.DataConnection, ml As MapObjects2.MapLayer
Dim e As MapObjects2.Rectangle

' -- connect to the data

dc.Database = App.Path & "\shapes"
If Not dc.Connect Then
  MsgBox "Could not find data"
  End
End If

' -- load the map layers

Set ml = New MapObjects2.MapLayer
ml.GeoDataset = dc.FindGeoDataset("states")
ml.Name = "States"
ml.Symbol.Color = RGB(230, 255, 230)
ml.Symbol.Outline = True
ml.Symbol.OutlineColor = RGB(120, 180, 120)
mapMain.Layers.Add ml

' -- set the map extent

Set e = ml.Extent
e.ScaleRectangle 1.1
mapMain.FullExtent = e
mapMain.Extent = mapMain.FullExtent

End Sub

Private Sub Form_Unload(Cancel As Integer)

Unload frmOverview
Unload frmMagnifier

End Sub

Private Sub mapMain_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)

Dim overVis As Boolean
Dim e As MapObjects2.Rectangle, p As MapObjects2.Point

If mFullRedraw Then
  mFullRedraw = False
  overVis = frmOverview.Visible
  
  ' -- if the magnifier is visible, send it to the back so it does not appear
  ' -- in the snapshot, take the snapshot, then restore the magnifer; do the
  ' -- same thing for the overview is necessary

  If frmMagnifier.Visible Then
    frmMagnifier.ZOrder vbSendToBack
    If overVis Then
      frmOverview.ZOrder vbSendToBack
    End If

    frmMain.Refresh
    frmMagnifier.Update

    If overVis Then
      frmOverview.StayOnTop True
    End If
    frmMagnifier.StayOnTop True
  End If

  ' -- set the new extent in the overview
  
  If overVis Then
    Set e = New MapObjects2.Rectangle
    Set p = mapMain.ToMapPoint(0, 0)
    e.Left = p.X
    e.Top = p.Y
    Set p = mapMain.ToMapPoint(mapMain.Width, mapMain.Height)
    e.Right = p.X
    e.Bottom = p.Y
    frmOverview.SetExtent e
  End If
End If


End Sub

Private Sub mapMain_BeforeLayerDraw(ByVal index As Integer, ByVal hDC As stdole.OLE_HANDLE)

' -- tell AfterLayerDraw that a full redraw has occurred

If index = mapMain.Layers.Count - 1 Then
  mFullRedraw = True
End If

End Sub

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

If Button = 1 Then
  mapMain.Extent = mapMain.TrackRectangle
Else
  mapMain.Pan
End If

End Sub