form1.frm

MO+VB的很多个简单示例

VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "Mo20.ocx"
Begin VB.Form Form1 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "改变地图当前显示范围实例"
   ClientHeight    =   5670
   ClientLeft      =   45
   ClientTop       =   315
   ClientWidth     =   7230
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5670
   ScaleWidth      =   7230
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdNextExtent 
      Caption         =   "下一显示范围"
      Height          =   255
      Left            =   5280
      TabIndex        =   6
      Top             =   120
      Width           =   1335
   End
   Begin VB.CommandButton cmdLastExtent 
      Caption         =   "上一显示范围"
      Height          =   255
      Left            =   3840
      TabIndex        =   5
      Top             =   120
      Width           =   1335
   End
   Begin VB.CommandButton cmdGlobe 
      Caption         =   "全图"
      Height          =   255
      Left            =   2640
      TabIndex        =   4
      Top             =   120
      Width           =   735
   End
   Begin VB.CommandButton cmdPan 
      Caption         =   "平移"
      Height          =   255
      Left            =   1800
      TabIndex        =   3
      Top             =   120
      Width           =   735
   End
   Begin VB.CommandButton cmdZoomOut 
      Caption         =   "缩小"
      Height          =   255
      Left            =   960
      TabIndex        =   2
      Top             =   120
      Width           =   735
   End
   Begin VB.CommandButton cmdZoomIn 
      Caption         =   "放大"
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   735
   End
   Begin MapObjects2.Map Map1 
      Height          =   5175
      Left            =   0
      TabIndex        =   0
      Top             =   480
      Width           =   7215
      _Version        =   131072
      _ExtentX        =   12726
      _ExtentY        =   9128
      _StockProps     =   225
      BackColor       =   16777215
      BorderStyle     =   1
      Contents        =   "Form1.frx":0000
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private strStatus As String '当前状态
Private LastExtent As Rectangle '上一个显示范围
Private NextExtent As Rectangle '下一个显示范围

'全图显示按钮单击事件响应代码
Private Sub cmdGlobe_Click()
    '保存当前显示范围
    LastExtent = Map1.Extent
    '设置Map1的当前显示范围是全图
    Set Map1.Extent = Map1.FullExtent
End Sub

'上一显示范围按钮单击事件响应代码
Private Sub cmdLastExtent_Click()
    If Not LastExtent Is Nothing Then
        Set NextExtent = Map1.Extent
        Set Map1.Extent = LastExtent
        Set LastExtent = Nothing
    End If
End Sub

'下一显示范围按钮单击事件响应代码
Private Sub cmdNextExtent_Click()
    If Not NextExtent Is Nothing Then
        Set LastExtent = Map1.Extent
        Set Map1.Extent = NextExtent
        Set NextExtent = Nothing
    End If
End Sub

'平移漫游按钮单击事件响应代码
Private Sub cmdPan_Click()
    '标志平移状态
    strStatus = "平移"
    '设置鼠标指针
    Map1.MousePointer = moPan
End Sub

'放大显示按钮单击事件响应代码
Private Sub cmdZoomIn_Click()
    '标志放大状态
    strStatus = "放大"
    '设置鼠标指针
    Map1.MousePointer = moZoomIn
End Sub

'缩小显示按钮单击事件响应代码
Private Sub cmdZoomOut_Click()
    '标志缩小状态
    strStatus = "缩小"
    '设置鼠标指针
    Map1.MousePointer = moZoomOut
End Sub


'Map Control的鼠标移动事件响应代码
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim tmpExtent As MapObjects2.Rectangle
        
    Select Case strStatus
        Case "放大"
            
            '放大地图当前显示范围
            
            '跟踪用户输入的矩形显示范围
            Set tmpExtent = Map1.TrackRectangle
            If Not tmpExtent Is Nothing Then
                '保存当前显示范围
                Set LastExtent = Map1.Extent
                '设置Map Control的当前显示范围为用户输入的矩形
                Set Map1.Extent = tmpExtent
            End If
        Case "缩小" '
            '缩小地图当前显示范围
            Set tmpExtent = Map1.Extent
            Dim MapWidth As Long
            '跟踪用户输入的矩形显示范围并获取其宽度
            MapWidth = Map1.TrackRectangle.Width
            '保存当前显示范围
            Set LastExtent = Map1.Extent
            If (MapWidth > 0) Then
                tmpExtent.ScaleRectangle Map1.Extent.Width / MapWidth
            Else
                tmpExtent.ScaleRectangle 1.5
            End If
            Set Map1.Extent = tmpExtent
        Case "平移"
            '进入平移漫游状态,跟踪鼠标动作
            '保存当前显示范围
            Set LastExtent = Map1.Extent
            Map1.Pan
    End Select
    End Sub