form02.frm

来自「一个关于基于MO编程的参考资料希望对大家的交流和学习有帮助」· FRM 代码 · 共 113 行

VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Begin VB.Form Form02 
   Caption         =   "墨西哥地图"
   ClientHeight    =   4650
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5940
   LinkTopic       =   "Form1"
   ScaleHeight     =   4650
   ScaleWidth      =   5940
   StartUpPosition =   3  '窗口缺省
   Begin MapObjects2.Map Map1 
      Height          =   4335
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   5775
      _Version        =   131072
      _ExtentX        =   10186
      _ExtentY        =   7646
      _StockProps     =   225
      BackColor       =   16777215
      BorderStyle     =   1
      Contents        =   "Form02.frx":0000
   End
End
Attribute VB_Name = "Form02"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Xuewei,2003/6/11
'设定Map大小；
'改变x1,x2，按百分比变化x方向的位置，改变y1,y2，按百分比变化y方向的位置；

Option Explicit

Dim Rect As MapObjects2.Rectangle
Dim x1 As Single, x2 As Single    'x方向前后位置比例
Dim y1 As Single, y2 As Single    'y方向上下位置比例

Private Sub Drect()
  Dim Rect1 As New MapObjects2.Rectangle
  Dim Mw As Single                  '原始宽度
  Dim Mh As Single                  '原始高度
  Dim Mwx As Single                 'x方向宽度变化系数
  Dim Kx0 As Single                 'x方向前后比例系数
  Dim Rx1 As Single, Rx2 As Single  'x方向计算后的前后宽度
  Dim Mwy As Single                 'y方向高度变化系数
  Dim Ky0 As Single                 'y方向上下比例系数
  Dim Ry1 As Single, Ry2 As Single  'y方向计算后的上下高度
      
  Set Rect = New MapObjects2.Rectangle
  Set Rect1 = Map1.Extent
  Mw = Rect1.Right - Rect1.Left
  Mh = Rect1.Top - Rect1.Bottom
  
  Mwx = 1 - x1 - x2
  If x1 = 0 Then
    Rx2 = Mw / (1 + (Mwx / x2))
    Rx1 = 0
  Else
    Kx0 = x2 / x1
    Rx1 = Mw / (1 + Kx0 + (Mwx / x1))
    Rx2 = Kx0 * Rx1
  End If
    
  Mwy = 1 - y1 - y2
  If y1 = 0 Then
    Ry2 = Mh / (1 + (Mwy / y2))
    Ry1 = 0
  Else
    Ky0 = y2 / y1
    Ry1 = Mh / (1 + Ky0 + (Mwy / y1))
    Ry2 = Ky0 * Ry1
  End If
  'MsgBox Ry1 & ",ry2=" & Ry2 & ",mh=" & Mh & ",mwr=" & Mwy * Ry1 / y1
  
  Rect.Left = Rect1.Left + Rx1
  Rect.Right = Rect1.Right - Rx2
  Rect.Bottom = Rect1.Bottom + Ry2
  Rect.Top = Rect1.Top - Ry1
End Sub

Private Sub Form_Load()
  DrawLayer   '加载墨西哥地图；
  x1 = 0.5
  x2 = 0.45
  y1 = 0.2
  y2 = 0.75
  Drect       '根据位置计算矩形；
  Set Map1.Extent = Rect.Extent
  Map1.Refresh
End Sub

Sub DrawLayer()
  Dim dc As New DataConnection
  Dim layer As MapLayer
  dc.Database = App.Path + "\..\" + "Mexico"
  If Not dc.Connect Then
    MsgBox "在指定的文件夹下没找到图层数据文件！"
    End
  End If
  
  Set layer = New MapLayer
  Set layer.GeoDataset = dc.FindGeoDataset("states")
  layer.Symbol.Color = moLimeGreen
  Map1.Layers.Add layer
End Sub